Index: perso/abdelouhab.djerrah/ORCHIDEE/AA_make
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/AA_make	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/AA_make	(revision 854)
@@ -0,0 +1,43 @@
+#- $Id$
+all : libparallel libparameters liborglob libstomate libsechiba
+
+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)
+
+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)
+
+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: perso/abdelouhab.djerrah/ORCHIDEE/AA_make.ldef
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/AA_make.ldef	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/AA_make.ldef	(revision 854)
@@ -0,0 +1,3 @@
+#- $Id$
+#---------------------------------------------------------------------
+#-
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/BIB/orchidee.bib
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/BIB/orchidee.bib	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/BIB/orchidee.bib	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsat.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_dev_qsatcalc.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_goff_gratch.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsat.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsatcalc.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_qsfrict_init.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_parameters/constantes_veg/constantes_veg_tempfunc.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowAlbedo.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+snowAlb=snowaIni+snowaDec \times \exp{\frac{-snowAge}{tsctSnowa}}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/SnowFraction.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+fracSnow=\frac{snow}{snow+10}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/condveg/z0cdrag1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+C = [\frac{1}{\kappa} ln(\frac{z}{z0})]^2 
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_intro.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_symbols.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.1.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_1.3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.1.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.1.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.4.tex	(revision 854)
@@ -0,0 +1,4 @@
+\begin{equation}
+{g_{{s}}(l)={{mA}}(l)\frac{h_{{r}}}{C_{{a}}}+b}
+\end{equation}
+
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffuco_trans_co2_2.4.5.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = U_{wind}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero10.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    zscf = \sqrt{(1 + cd |Ri_{z}|)}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero11.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+     cd_{tmp}=\frac {cd_{neut}}{1+3 c_b Ri_z zscf}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero12.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero13.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+     cd_{tmp} = cd_{neut} (1-3 cb* Ri_{z} * zscf)
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero14.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Z_g = Z_{lev} g_0
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero3.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Z_d^\phi = \left( \frac{Z_g} {C_{p,air}} \right)
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero4.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero5.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{V, surf} = T_g (1 + retv q_{surf})
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero6.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \left( {\frac{\delta u}{\delta z}} \right) ^2 = max \{ (0.1)^2, U^2  \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero7.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero8.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    Ri_{z} = max \{   min   \{Ri_z, 5    \}, -5  \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaero9.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    cd_{neut} = \left(  \frac{  \kappa }  {\frac{LOG(zlev + roughheight)}{z_0} }               \right)^2
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucoaerod2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    r_{a} = \frac{1}{q_{c,drag}U}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucobare3.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,4} = evap_{bare, lim}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \sum_1^{nvm} (\beta_{v,2}); \  \sum_1^{nvm} (\beta_{v,3})   
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_v = 1; \ \alpha_v = 1    
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb4.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \sum_1^{nvm} (veget); \  \sum_2^{nvm} (veget)   
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb5.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb6.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb7.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb8.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{eqnarray}
+    \beta_{v,3} = 0; \ RH = 0     
+\end{eqnarray}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucocomb9.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{eqnarray}
+    \beta_{v,2} = 0       
+\end{eqnarray}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer1.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer4.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer5.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    z_{rapp} = \frac{qs_{int}^{veg}}{ziltest}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer6.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,23} = max \left\{  \beta_{v,2} - \beta_{v,2}z_{rapp} , 0 \right\}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucointer7.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \beta_{v,2} = \beta_{v,2} z_{rapp}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    \delta _c = \rho . max\{ (q_{sat} - q_{a}), 0 \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{ (U_{wind})_{min}, U_{wind} \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans4.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans5.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/diffuco/diffucotrans6.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_intro2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbil_symbols.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    ps^{old} = T_S C_p
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin3.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R^{LW}_{abs} = \epsilon R^{LW}_{\downarrow}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilbegin4.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg4.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max\{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg5.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg6.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Interception) = xx \beta_{v2}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg7.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   (Transpiration) = xx \beta_{v3}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg8.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   U = max \{U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilevapveg9.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U=max\{U_{min}, \sqrt{u^2+v^2} \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux10.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux11.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux12.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H = \rho q_c (ps^{new}- E^{pot}_{air})
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux13.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   R^{LW}_{net} = R^{LW}_{\downarrow}-R^{LW}_{\uparrow}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux14.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux15.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T_{air}= \frac{E^{pot}_{air}}{c_{p, air}}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_c=|v|q_{c, drag}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux4.tex	(revision 854)
@@ -0,0 +1,4 @@
+\begin{equation}
+    R^{LW}_{\uparrow}=R^{LW}_{\uparrow}+(1-\epsilon)R^{LW}_{\downarrow}
+\end{equation}
+
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux5.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{rad}=\epsilon \sigma T_{s}^4 + R^{LW}_{\uparrow}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux6.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux7.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_s = max \{q_s, q_{air} \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux8.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    R_{net}=R^{LW}_{\downarrow}+R^{SW}_{net}-R^{LW}_{\uparrow}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilflux9.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    (fusion) = (melt)_{tot} \frac {\lambda E_{sub}^0}{\Delta t}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilfusion2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{new} = T_{s}^{new} - \frac {(melt)_{tot} \lambda E_{sub}^0}{(soilcap)}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    U = max \{ U_{min}, \sqrt{u^2 + v^2} \}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp10.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp11.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp12.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp13.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    ps^{new} = ps^{old} + \Delta \theta
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp14.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp15.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{s}^{new} = \frac {ps^{new}}{C_p^{air}}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp16.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    E_{pot}^{air,new} = z_{ikt} (H^{old} - H^{sns} \Delta \theta) + ps^{new}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp17.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp18.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    q_{air}^{new}(ji) = q_{air}(ji)
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp19.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp3.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H^{old} = \frac{B_T^{orc} - ps^{old}}{z_{ikt} - A_T^{orc}}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp4.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp5.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp6.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp7.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp8.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilsurftemp9.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/enerbilt2mdiag1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    T_{dgnc}^{2m} = T_{air} 
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/equations_collated.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ1.tex	(revision 854)
@@ -0,0 +1,4 @@
+\begin{equation}
+    A_T^{orc} = B_T^{lmdz} \Delta t
+\end{equation}
+
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    B_T^{orc} = A_T^{lmdz}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ3.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    A_q^{orc} = B_q^{lmdz} \Delta t
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/enerbil/surflandLMDZ4.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    B_q^{orc} = A_q^{lmdz}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/bdiff.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/drs.tex	(revision 854)
@@ -0,0 +1,4 @@
+\begin{eqnarray}\label(eq:drs}
+R_s & = & 0.05 R \\
+D & = & 0.95 R
+\end{eqnarray}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/gdrainage.tex	(revision 854)
@@ -0,0 +1,9 @@
+The drainage from the top to the bottom soil layer is slower when the top soil moisture $W_t$ is low, and accelerates above a threshold moisture $W_t^\mathrm{lim}$. It is ruled by the following set of equations, where $D_t^\mathrm{min}$, $D_t^\mathrm{max}$, and $\alpha_t$ are specific parameters:
+\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}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hdiff.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:hdiff}
+\Delta X_j = - \frac{\Delta t}{\tau_h}(X_j-\overline{X})
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}\label{eq:us1}
+U_s=  \exp (-c_j \, h_t^d )
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/humrel2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+snowmelt=\frac{(temp\_sol\_new - tp\_00)*soilcap}{chalfu0}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/hydrolcsnow3.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+d\_age\_nobio=\frac{d\_age}{1+(\frac{tp\_00-T}{7.})^4}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/interception.tex	(revision 854)
@@ -0,0 +1,14 @@
+The following 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 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 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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/hydrolc/rsol.tex	(revision 854)
@@ -0,0 +1,7 @@
+\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}
+
+\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).
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init0.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+\frac{\partial T}{\partial t}=\frac{\partial ^2 T}{\partial z^2}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_sechiba/thermosoil/thermosoil_var_init00.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+C_p\frac{\partial T}{\partial t}=K\frac{\partial ^2 T}{\partial z^2}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown1.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    H = k_{allom2} \times D^{k_{allom3}}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_crown/lpj_crown3.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+    CA =\min(k_{allom1} \times D^{k_{rp}},CA_{max})
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_establish/equation_lpj_establish.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_1.tex	(revision 854)
@@ -0,0 +1,6 @@
+\begin{equation}
+p(m)=e^{-\pi*\left(\frac{m}{m_e}\right)^{2}}
+\end{equation}
+
+
+
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_fire/lpj_fire_2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap1.tex	(revision 854)
@@ -0,0 +1,4 @@
+\begin{equation}
+greff=\frac{\Delta}{C_{leaf}*SLA}
+\end{equation}
+
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_gap/gap2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+mort_{greff}=\frac{k_{mort1}}{1+k_{mort2}*greff}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/lpj_pftinout/equation_lpj_pftinout.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+A\propto \frac{\sum X_{i}}{\sum X_{i}+\sum Y_{j}}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc4.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc5.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc6.tex	(revision 854)
@@ -0,0 +1,6 @@
+\begin{equation}
+
+
+\mathit{transloc\_leaf}=\frac{\mathit{L0}}{\mathit{L0}+\mathit{R0}}\cdot \mathit{use\_reserve}
+
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc7.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_alloc/alloc8.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_SLA_Reich_97.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_grass.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_sapl_tree.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_data/stomate_data_stem_diameter.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   M=MAX(0.25,MIN(1,M)
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_moist_func2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=e^{0.69*(\frac{temp-303}{10})}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=MIN(1,T)
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/control_temp_func2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   T=MIN(1,T)
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   DLC=1-e^{(-0.5*LAI)}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/deadleaf2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   M=-1.1*soilmoisture^2+2.4*soilmoisture-0.29
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   F=0.85-0.018*L*CN
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   k=\frac{1}{litter tau}*T*M
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal3.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dDL}{dt}=DL*(1-k)
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal4.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dInput}{dt}=f*C*(1-L)
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_litter/littercal5.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+   \frac{dLAI}{dt}=DL*sla*vegetmax
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_hummoigdd_gddcrit_eqn4.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_lm_min_eqn2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moi_availcrit_eqn3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_moiavail_eqn1.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_phenology/phenology_ncdgdd_gddmin_eqn5.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe1.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_prescribe/prescribe2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+\mathit{rpc}=\frac{1}{1-e^{-{\frac{\mathit{z\_soil}\left(nbdl\right)}{\mathit{rprof}}}}}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp4.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_resp/resp5.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_consumption_eqn4.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_herbivore_eqn5.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_lin_relax_eqn1.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_moiavail_eqn.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_ncdmax_eqn2.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+ncd_{max} = 3. * one\_year 
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_soilhum_month_eqn.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_season/season_t2m_long_ref_eqn3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq1.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+f_{active\rightarrow slow}=1-(0.85-0.68\times clay)-f_{active\rightarrow passive}.
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq3.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+Flux_{active}=Flux_{active}\cdot(1-0.75\times clay) . \nonumber
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq4.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+C_{pool} = C_{pool}-Flux_{pool}
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq5.tex	(revision 854)
@@ -0,0 +1,3 @@
+\begin{equation}
+Resp_{soil}=\sum_{pool}(f_{pool\rightarrow atmosphere}\times Flux_{pool}).
+\end{equation}
Index: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_soilcarbon/soilcarbon_eq6.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_age_senes_biomass_eqn5.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_clim_senes_biomass_eqn4.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_lma_update_eqn1.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_moist_crit_eqn3.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_temp_crit_eqn2.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LAI_eqn7.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/ORCHIDEE/src_stomate/stomate_turnover/turnover_update_LeafAgeDistribution_eqn6.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/TOOLS/codealgo.awk
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/TOOLS/codealgo.awk	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/TOOLS/codealgo.awk	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/TOOLS/codedox.awk
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/TOOLS/codedox.awk	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/TOOLS/codedox.awk	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/TOOLS/codeinc.awk
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/TOOLS/codeinc.awk	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/TOOLS/codeinc.awk	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/footer.tex
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/footer.tex	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/footer.tex	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/DOC/header.tex.init
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/DOC/header.tex.init	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/DOC/header.tex.init	(revision 854)
@@ -0,0 +1,251 @@
+\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[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: perso/abdelouhab.djerrah/ORCHIDEE/Doxyfile_ORCHIDEE.init
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/Doxyfile_ORCHIDEE.init	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/Doxyfile_ORCHIDEE.init	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/ORCHIDEE_CeCILL.LIC
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/ORCHIDEE_CeCILL.LIC	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/ORCHIDEE_CeCILL.LIC	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-MPI.fcm
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-MPI.fcm	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-MPI.fcm	(revision 854)
@@ -0,0 +1,17 @@
+%AR                  ar
+%MAKE                gmake
+%FPP                 cpp
+%COMPILER            /usr/local/bin/mpif90 
+%LINKER              /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
+%LD_BASE             -g
+%MPI_FFLAGS          
+%MPI_LD              
+%OMP_FFLAGS          
+%OMP_LD              
+
Index: perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-MPI.path
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-MPI.path	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-MPI.path	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-SX8_MERCURE.fcm
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-SX8_MERCURE.fcm	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-SX8_MERCURE.fcm	(revision 854)
@@ -0,0 +1,16 @@
+%AR                  sxar
+%MAKE                make
+%COMPILER            sxmpif90
+%LINKER              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 
+%LD_BASE             -size_t64 -lblas
+%MPI_FFLAGS          " "
+%MPI_LD              " "
+%OMP_FFLAGS          -P openmp
+%OMP_LD              -P openmp  -Wl,"-ZL 8G"
+
Index: perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-SX8_MERCURE.path
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-SX8_MERCURE.path	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/arch/arch-SX8_MERCURE.path	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/makeorchidee_fcm
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/makeorchidee_fcm	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/makeorchidee_fcm	(revision 854)
@@ -0,0 +1,279 @@
+#!/bin/csh
+#set verbose echo
+set is_parallel_opt       = FALSE
+set is_driver_opt         = FALSE
+set is_arch_opt           = FALSE 
+set is_compile_opt        = FALSE
+set default_compile_flags = "%PROD_FFLAGS"
+set fcm_path=none
+
+setenv P_P ""
+setenv SECTIONS_PARA ""
+
+top:
+if ($#argv > 0) then
+    switch ($1)
+
+    case -h
+
+########################################################################
+# 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
+
+[ -a|-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)
+
+[-fcm_path path]           : path for fcm (default: the default fcm path in environment)
+
+[ -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/ORCHIDEE_OL directories for each file
+
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+
+    case -parallel
+        set is_parallel_opt = TRUE
+        set parallel=$2 ; shift ; shift ; goto top
+
+    case -p
+        set is_parallel_opt = TRUE
+        set parallel=$2 ; shift ; shift ; goto top
+                        
+    case -driver
+        set is_driver_opt = TRUE
+        shift ; goto top
+
+    case -a
+    case -arch
+        set is_arch_opt = TRUE
+        set arch="$2" ; shift ; shift ; goto top
+
+    case -prod
+        set is_compile_opt = TRUE
+        set compile_flags="%PROD_FFLAGS"
+        shift ; goto top
+
+    case -dev
+        set is_compile_opt = TRUE
+        set compile_flags="%DEV_FFLAGS"
+        shift ; goto top
+
+    case -d
+    case -debug
+        set is_compile_opt = TRUE
+        set compile_flags="%DEBUG_FFLAGS"
+        shift ; goto top
+
+    case -fcm_path
+       set fcm_path=$2 ; shift ; shift ; goto top
+
+    case -doc_para
+        setenv P_P -DCPP_PARA
+	setenv SECTIONS_PARA "-e s&ENABLED_SECTIONS\ *= &ENABLED_SECTIONS       = CPP_PARA&g"
+	goto doc
+
+    case -doc
+doc:    
+        unalias cd
+	setenv REV `svn info | grep vision | sed -e 's&.*vision.*: \([0-9]*\)&\1&' | head -n 1`
+	setenv 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
+	setenv MODELPATH ${PWD}
+	\mkdir modeles_doc
+	setenv SRCPATH ${MODELPATH}/modeles_doc
+
+	find ORCHIDEE_OL \( -not -path '*.svn*' \
+			-a \( -name '*.f90' -o -name "*.F90" -o -name "*.h" \) \) \
+		    -exec bash -c 'mkdir -p '${SRCPATH}'/$( dirname {} ); cp -p {} '${SRCPATH}'/$( dirname {} )' \;
+
+	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
+	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
+
+    case -rmdoc
+	\rm -rf docs
+        shift ; goto top
+
+    case -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/\..*//" )' \;
+	find ORCHIDEE_OL \( -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 ; goto top
+
+    default
+        echo "unknown option "$1" , exiting..."
+        exit 
+   endsw
+endif
+
+###############################################################
+# mettre le chemin du fcm dans le path
+###############################################################
+if  ( "$fcm_path" != 'none' ) then
+    setenv PATH ${fcm_path}:${PATH}
+endif
+
+echo "Chemin du fcm utlise :" 
+which fcm
+
+
+#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
+  endif
+  
+  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
+  endif
+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
+  endif
+
+  if ( ! -e arch.fcm ) then
+    echo "architecture file : << arch.path >> is missing, exiting...."
+    exit
+  endif
+endif
+  
+# set compiler flags
+set FFLAGS="%BASE_FFLAGS"
+set LD_FFLAGS="%LD_BASE"
+set CPP_KEY="%FPP_DEF"
+
+# set compiler flags for optimisation
+if ( $is_compile_opt == FALSE ) then
+  set compile_flags=$default_compile_flags
+endif
+set FFLAGS=${FFLAGS}" "$compile_flags
+
+# set compiler flags for parallelism
+if ( $is_parallel_opt == TRUE ) then
+  echo $parallel 
+  switch ($parallel)
+    case mpi
+    case MPI
+      set FFLAGS="${FFLAGS} %MPI_FFLAGS"
+      set LD_FFLAGS="%MPI_LD ${LD_FFLAGS}"
+      set CPP_KEY="CPP_PARA ${CPP_KEY}"
+      breaksw
+    case omp
+    case OMP
+      set FFLAGS="${FFLAGS} %OMP_FFLAGS"
+      set LD_FFLAGS="%OMP_LD ${LD_FFLAGS}"
+      set CPP_KEY="CPP_OMP CPP_PARA ${CPP_KEY}"
+      breaksw
+    case mpi_omp
+    case MPI_OMP
+      set FFLAGS="${FFLAGS} %MPI_FFLAGS %OMP_FFLAGS"
+      set LD_FFLAGS="%MPI_LD %OMP_LD ${LD_FFLAGS}"
+      set CPP_KEY="CPP_OMP CPP_PARA ${CPP_KEY}"
+      breaksw
+    
+    default
+        echo "unknown option for parallelism :$parallel , only <<mpi>>, <<MPI>> or <<omp>>, <<OMP>> or <<mpi_omp>> <<MPI_OMP>> allowed , exiting..."
+        exit 
+   endsw
+endif
+       
+# set target
+set TARGET = liborchidee.a
+if ( $is_driver_opt == TRUE) then
+  set TARGET="liborchidee_ol.a dim2_driver.exe teststomate.exe forcesoil.exe"
+endif
+
+source ./arch.path
+
+# build config file
+set config_fcm="config.fcm"
+rm -f $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
+
+
+fcm build
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_global/AA_make
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_global/AA_make	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_global/AA_make	(revision 854)
@@ -0,0 +1,64 @@
+#-
+#- $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
+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
+#-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_veg.o)
+
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_global/AA_make.ldef
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_global/AA_make.ldef	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_global/AA_make.ldef	(revision 854)
@@ -0,0 +1,18 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a ORGLOB
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+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: perso/abdelouhab.djerrah/ORCHIDEE/src_global/grid.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_global/grid.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_global/grid.f90	(revision 854)
@@ -0,0 +1,548 @@
+
+!! 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 parallel
+
+  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 = .FALSE.
+  !
+  !-
+  !- 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
+  !-
+  !! Geographical coordinates
+  REAL(r_std), ALLOCATABLE, DIMENSION (:,:), SAVE     :: lalo
+  !! index  of land points
+  INTEGER, ALLOCATABLE, DIMENSION (:), SAVE          :: ilandindex,jlandindex
+  !- 
+  !! Fraction of continents.
+  REAL(r_std), ALLOCATABLE, DIMENSION (:), SAVE       :: 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
+  !
+  ! 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
+  REAL(r_std), DIMENSION(2), SAVE :: min_resol,max_resol
+  REAL(r_std), ALLOCATABLE, DIMENSION (:), SAVE     :: area
+  !
+  !
+  ! Get the direction of the grid
+  !
+  CHARACTER(LEN=2), DIMENSION(2), SAVE, PRIVATE      :: 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
+  !
+  ! The calendar
+  CHARACTER(LEN=20), SAVE         :: calendar_str
+  !
+  ! The date
+  REAL(r_std)                     :: in_julian
+  ! Diff with day 0
+  REAL(r_std)                     :: julian_diff
+  !
+  INTEGER(i_std)                  :: year, month, day
+  REAL(r_std)                     :: sec
+  !
+  ! month_len (d)
+  INTEGER(i_std)                  :: month_len
+  !
+  ! year length (d)
+  INTEGER(i_std), SAVE            :: year_length=0
+  !
+  ! Ration between calendar year in days (ie 360d or 365d ...) to gregorian year length 
+  REAL(r_std) :: 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
+    REAL(r_std), PARAMETER                          :: min_stomate = 1.E-8
+    REAL(r_std), SAVE                               :: pi
+    
+    ! =========================================================================
+    
+    pi = 4. * ATAN(1.)
+
+    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.
+          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. ), 0.001 )     
+          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: perso/abdelouhab.djerrah/ORCHIDEE/src_global/interpol_help.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_global/interpol_help.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_global/interpol_help.f90	(revision 854)
@@ -0,0 +1,876 @@
+!
+! 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 IOIPSL,  ONLY : ipslerr
+
+  USE constantes
+  USE constantes_veg
+  USE parallel
+
+  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
+  !
+  REAL(r_std), PARAMETER                          :: mincos  = 0.0001
+  !
+  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)
+    !
+    ! 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_aggrgate_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 ( 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
+          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
+       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
+          CALL ipslerr(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
+    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
+    INTEGER(i_std) :: ip, ib, i, j, itmp, iprog, nbind
+    REAL(r_std) :: domain_minlon,domain_maxlon,domain_minlat,domain_maxlat
+    INTEGER(i_std) :: ff(1)
+    LOGICAL        :: found
+
+    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)
+    !
+    ! 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 = lon_rel(ip) + resol_lon/(2.0*coslat)
+          lolowrel = lon_rel(ip) - resol_lon/(2.0*coslat)
+          coslat = pi/180. * R_Earth
+          lauprel = lat_rel(ip) + resol_lat/(2.0*coslat)
+          lalowrel = lat_rel(ip) - resol_lat/(2.0*coslat)
+          !
+          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'
+    !
+    WRITE(numout,*) 'Aggregate_vec : ', 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(:) = zero
+    fopt_max = -1
+    !
+    ! We select here the case which is fastest, i.e. when the smaller loop is inside
+    !
+    IF ( nbpt > nbind ) THEN
+       !
+       loopnbpt : 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.
+          !
+          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 = lon_rel(ip) + resol_lon/(2.0*coslat)
+             lolowrel = lon_rel(ip) - resol_lon/(2.0*coslat)
+             !
+             latrel = lat_rel(ip)
+             coslat = pi/180. * R_Earth
+             lauprel = lat_rel(ip) + resol_lat/(2.0*coslat)
+             lalowrel = lat_rel(ip) - resol_lat/(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 loopnbpt
+                   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
+                      !
+                      ! 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. &
+                           &  lauprel < lat_up .AND. lalowrel > lat_low ) THEN
+                         searchind(i) = 0
+                      ENDIF
+                      !
+                   ENDIF
+                ENDIF       ! IF lat
+             ENDIF          ! IF lon
+          ENDDO
+          !
+          ! De-select the marked points
+          !
+          itmp = nbind
+          nbind = 0
+          DO i=1,itmp
+             IF ( searchind(i) > 0 ) THEN
+                nbind = nbind + 1
+                searchind(nbind) = searchind(i)
+             ENDIF
+          ENDDO
+          !
+       ENDDO loopnbpt
+       IF (err_fopt) THEN
+          WRITE(numout,*) 'Reached value ', fopt(ib),' for fopt on point', ib
+          CALL ipslerr(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
+       !
+    ELSE
+       !
+       ib = 1
+       !
+       loopnbind : DO i=1,nbind
+          !
+          !
+          !   Give a progress meter
+          !
+#ifdef INTERPOL_ADVANCE
+          iprog = NINT(REAL(i,r_std)/REAL(nbind,r_std)*79.) - NINT(REAL(i-1,r_std)/REAL(nbind,r_std)*79.)
+          IF ( iprog .NE. 0 ) THEN
+             WRITE(numout,'(a1,$)') 'y'
+          ENDIF
+#endif
+          !
+          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 = lon_rel(ip) + resol_lon/(2.0*coslat)
+          lolowrel = lon_rel(ip) - resol_lon/(2.0*coslat)
+          !
+          latrel = lat_rel(ip)
+          coslat = pi/180. * R_Earth
+          lauprel = lat_rel(ip) + resol_lat/(2.0*coslat)
+          lalowrel = lat_rel(ip) - resol_lat/(2.0*coslat)
+          !
+          !
+          found = .FALSE.
+          j = 1
+          !
+          DO WHILE ( .NOT. found .AND. j <= nbpt ) 
+             ! Just count the number of time we were through
+             j = j+1
+             !
+             !  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
+                      found = .TRUE.
+                      !
+                   ENDIF
+                ENDIF       ! IF lat
+             ENDIF          ! IF lon
+          ENDDO             ! While loop
+       ENDDO loopnbind
+       !
+       IF (err_fopt) THEN
+          WRITE(numout,*) 'Reached value ', fopt(ib),' for fopt on point', ib
+          CALL ipslerr(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
+       !
+       IF ( .NOT. found ) THEN
+          ! We need to step on in the coarse grid
+          ib = ib + 1
+          IF ( ib > nbpt ) ib = ib-nbpt
+          !
+       ENDIF
+    ENDIF
+    WRITE(numout,*) 
+    WRITE(numout,*) "aggregate_vec nbvmax = ",incmax, "max used = ",fopt_max
+    !
+    ! Do some memory management.
+    !
+    DEALLOCATE (searchind)
+    !
+    ! 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: perso/abdelouhab.djerrah/ORCHIDEE/src_global/solar.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_global/solar.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_global/solar.f90	(revision 854)
@@ -0,0 +1,202 @@
+!! This module define solar 
+!!
+!! @call sechiba_main
+!! @Version : $Revision$, $Date$
+!! 
+!< $HeadURL$
+!< $Date$
+!< $Author$
+!< $Revision$
+!!
+!! @author Marie-Alice Foujols, Jan Polcher and Martial Mancip
+!! 
+!!
+MODULE solar
+
+  USE defprec
+  USE constantes
+  USE parallel
+
+  IMPLICIT NONE
+
+
+
+CONTAINS
+  !
+  !f90doc CONTAINS
+  ! 
+  !
+  !
+  !-
+  !=====================================================================
+  SUBROUTINE solarang (julian, julian0, iim, jjm, lon, lat, csang)
+    !---------------------------------------------------------------------
+    !- This subroutine computes the solar angle according to the method
+    !- used by GSWP and developed by J.C. Morill.
+    !- See for further details :
+    !- http://www.atmo.arizona.edu/~morrill/swrad.html
+    !---------------------------------------------------------------------
+    !
+    USE calendar
+    !
+    IMPLICIT NONE
+    !-
+    INTEGER,INTENT(in) :: iim, jjm
+    REAL,INTENT(in)  :: julian
+    REAL,INTENT(in)  :: julian0
+    REAL,DIMENSION(iim,jjm), INTENT(in)  :: lon, lat
+    REAL,DIMENSION(iim,jjm), INTENT(out) :: csang
+    !-
+    REAL :: pi, gamma, dec, decd
+    REAL :: et, gmt, le, ls, lcorr, latime, omega, omegad
+    REAL :: llatd, llat
+    INTEGER :: igmt, ilon, ilat
+    INTEGER,SAVE,ALLOCATABLE :: zone(:), lhour(:)
+    !
+    LOGICAL :: check = .FALSE.
+    !---------------------------------------------------------------------
+    !
+    pi = 4.*ATAN(1.)
+    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(igmt, 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 (gmt, iim, jjm, lon, zone, lhour)
+    !---------------------------------------------------------------------
+    !
+    IMPLICIT NONE
+    !
+    INTEGER :: gmt, iim, jjm, zone(iim), lhour(iim)
+    REAL :: lon(iim,jjm)
+    !-
+    INTEGER :: deg
+    !!??   REAL :: deg
+    INTEGER :: i, ilon, change
+    !---------------------------------------------------------------------
+    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) > 23) lhour(ilon) = lhour(ilon)-24
+       !---
+    ENDDO
+    !-----------------------
+  END SUBROUTINE time_zone
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  
+END MODULE solar
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/AA_make
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/AA_make	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/AA_make	(revision 854)
@@ -0,0 +1,94 @@
+#-
+#- $Id$
+#-
+MODS1 = data_para.f90 \
+        timer.f90 \
+        transfert_para.f90 \
+	ioipsl_para.f90 \
+	tools_para.f90 \
+	parallel.f90
+#\
+# 	orch_write_field.f90 \
+# 	write_field.f90 \
+# 	orch_write_field_p.f90\
+# 	write_field_p.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) 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
+#-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 PARALLEL $(MODS1)
+	echo 'Configuration of PARALLEL done'
+
+clean:
+	$(RM) $(MODEL_LIB)
+
+$(MODEL_LIB)(mpi_dummy.o):
+
+$(MODEL_LIB)(timer.o):
+
+$(MODEL_LIB)(data_para.o):
+
+$(MODEL_LIB)(orch_write_field.o):
+
+$(MODEL_LIB)(write_field_p.o): \
+  $(MODEL_LIB)(orch_write_field.o)
+
+$(MODEL_LIB)(transfert_para.o): \
+  $(MODEL_LIB)(timer.o) \
+  $(MODEL_LIB)(data_para.o) \
+
+$(MODEL_LIB)(ioipsl_para.o): \
+  $(MODEL_LIB)(transfert_para.o) \
+  $(MODEL_LIB)(data_para.o)
+
+$(MODEL_LIB)(tools_para.o): \
+  $(MODEL_LIB)(timer.o) \
+  $(MODEL_LIB)(data_para.o)
+
+$(MODEL_LIB)(orch_write_field_p.o): \
+  $(MODEL_LIB)(parallel.o)
+
+$(MODEL_LIB)(write_field_p.o): \
+  $(MODEL_LIB)(parallel.o) \
+  $(MODEL_LIB)(orch_write_field_p.o)
+
+$(MODEL_LIB)(parallel.o): \
+  $(MODEL_LIB)(data_para.o) \
+  $(MODEL_LIB)(transfert_para.o) \
+  $(MODEL_LIB)(ioipsl_para.o) 
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/AA_make.ldef
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/AA_make.ldef	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/AA_make.ldef	(revision 854)
@@ -0,0 +1,19 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a PARALLEL
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+ORDIR  = ..
+#---------------------------------------------------------------------
+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: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/data_para.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/data_para.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/data_para.f90	(revision 854)
@@ -0,0 +1,530 @@
+! Definition and allocation of parallel datas.
+! Initialization of parallel or sequentiel IOs.
+! Definition of Load Balancing functions.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE data_para
+
+!-
+  USE defprec
+  USE ioipsl
+!-
+#include "src_parallel.h"
+!-
+!-
+! Unit for output messages
+  INTEGER(i_std), SAVE :: numout = 6
+
+  INTEGER, SAVE :: mpi_size                                           !! Number of parallel processes
+  INTEGER, SAVE :: mpi_rank                                           !! my rank num
+  INTEGER, SAVE :: root_prc                                           !! rank of root proc
+  LOGICAL, SAVE :: is_root_prc                                        !! Only root proc is true
+  INTEGER, SAVE :: nbp_loc                                            !! number of local continental points
+  INTEGER, SAVE :: nbp_glo                                            !! number of global continental points
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_para_nb
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_para_begin
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: nbp_para_end
+  
+  INTEGER,SAVE :: iim_g, jjm_g                                  !! Dimension of global fields
+  ! 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
+ 
+  
+  !! 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
+ 
+  INTEGER, SAVE :: MPI_COMM_ORCH
+  INTEGER, SAVE :: MPI_REAL_ORCH
+  INTEGER, SAVE :: MPI_INT_ORCH
+  LOGICAL, SAVE :: cpl_lmdz
+  
+  INTEGER, SAVE :: orch_domain_id
+  
+CONTAINS
+  
+  SUBROUTINE init_para(cpl_lmdz_x, communicator)
+
+    IMPLICIT NONE
+    
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+    LOGICAL :: cpl_lmdz_x
+    INTEGER,OPTIONAL :: communicator
+    INTEGER :: ierr
+    CHARACTER(LEN=20) :: filename
+    INTEGER :: i, div
+    CHARACTER(LEN=4) :: num
+    LOGICAL, PARAMETER :: check = .FALSE.
+
+    cpl_lmdz=cpl_lmdz_x
+      
+#ifdef CPP_PARA
+    ! Orchidee communicator :
+    IF (.NOT. cpl_lmdz) THEN
+       CALL MPI_INIT(ierr)
+       IF (ierr /= 0) THEN
+          WRITE(*,*) 'INIT_PARA : MPI_INIT failed with ',ierr
+          STOP "INIT_PARA"          
+       ENDIF
+       MPI_COMM_ORCH=MPI_COMM_WORLD
+    ELSE
+       MPI_COMM_ORCH=communicator
+    ENDIF
+	  
+    
+    ! Int and real precision
+    IF (MPI_VERSION == 1) THEN
+       ! Version MPI 1.x
+       IF (i_std==i_4) THEN
+          MPI_INT_ORCH=MPI_INTEGER
+       ELSEIF (i_std==i_8) THEN
+          MPI_INT_ORCH=MPI_INTEGER
+       ELSE
+          MPI_INT_ORCH=MPI_INTEGER
+       ENDIF
+       
+       IF (r_std==r_4) THEN
+          MPI_REAL_ORCH=MPI_REAL
+       ELSEIF (r_std==r_8) THEN
+          MPI_REAL_ORCH=MPI_DOUBLE_PRECISION
+       ELSE
+          MPI_REAL_ORCH=MPI_REAL
+       ENDIF
+    ELSE
+       ! Others MPI
+       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
+      
+    CALL MPI_COMM_SIZE(MPI_COMM_ORCH,mpi_size,ierr)
+    IF (ierr /= 0) THEN
+       WRITE(*,*) 'INIT_PARA : MPI_COMM_SIZE failed with ',ierr
+       STOP "INIT_PARA"
+    ENDIF
+    CALL MPI_COMM_RANK(MPI_COMM_ORCH,mpi_rank,ierr)
+    IF (ierr /= 0) THEN
+       WRITE(*,*) 'INIT_PARA : MPI_COMM_RANK failed with ',ierr
+       STOP "INIT_PARA"
+    ENDIF
+      
+#else
+    mpi_rank=0
+    mpi_size=1    
+#endif
+    root_prc=0
+      
+    IF (mpi_rank==0) THEN
+       is_root_prc=.TRUE.
+    ELSE
+       is_root_prc=.FALSE.
+    ENDIF
+
+    ! Open mpi_rank outputs or select stdout 
+    IF (mpi_size > 1) THEN
+       write(num,'(I4.4)') mpi_rank
+       
+       numout = 100
+       
+       filename =  'out_orchidee_'//num
+       
+       OPEN(UNIT=numout,FILE=TRIM(filename),ACTION='write',STATUS='unknown',FORM='formatted',IOSTAT=ierr) 
+       IF (ierr /= 0) THEN
+#ifdef CPP_PARA
+          CALL MPI_FINALIZE(ierr)
+#endif
+          WRITE(*,*) "Erreur can't open file ", filename
+          STOP "INIT_PARA"
+       ENDIF
+    ELSE
+       numout = 6
+    ENDIF
+
+    IF (check) THEN
+#ifdef CPP_PARA
+       WRITE(numout,*) 'version MPI ', MPI_VERSION, MPI_SUBVERSION
+       WRITE(numout,*) 'INTEGERS ',MPI_INTEGER4,MPI_INTEGER8,MPI_INTEGER,MPI_INT_ORCH
+       WRITE(numout,*) 'REALS ',MPI_REAL4,MPI_REAL8,MPI_REAL,MPI_REAL_ORCH
+#endif
+       WRITE(numout,*) 'RANK ',mpi_rank,' SIZE ',mpi_size
+       WRITE(numout,*) "Am I root process ?",is_root_prc
+       WRITE(numout,*) "Init_para : For process number ",mpi_rank, "output file = ",filename
+    ENDIF
+      
+  END SUBROUTINE init_para
+ 
+  SUBROUTINE init_data_para(iim,jjm,nbpoints,index_x)
+
+    IMPLICIT NONE
+#ifdef CPP_PARA
+    INCLUDE 'mpif.h'
+#endif
+
+    INTEGER,INTENT(IN) :: iim
+    INTEGER,INTENT(IN) :: jjm
+    INTEGER,INTENT(IN) :: nbpoints
+    INTEGER,DIMENSION(:),INTENT(IN) :: index_x
+
+    INTEGER,ALLOCATABLE,DIMENSION(:) :: index_l
+    INTEGER,ALLOCATABLE,DIMENSION(:) :: displs
+#ifdef CPP_PARA
+    INTEGER :: ierr
+#endif  
+    INTEGER :: i
+    LOGICAL, PARAMETER :: check=.FALSE.
+
+
+    IF (check) WRITE(numout,*) 'INIT_DATA_PARA',iim,jjm,nbpoints,index_x
+    ALLOCATE(nbp_para_nb(0:mpi_size-1))
+    ALLOCATE(nbp_para_begin(0:mpi_size-1))
+    ALLOCATE(nbp_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))
+
+    IF (cpl_lmdz) THEN
+#ifdef CPP_PARA
+       CALL MPI_GATHER(nbpoints,1,MPI_INT_ORCH,nbp_para_nb,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+#else
+       nbp_para_nb(0)=nbpoints
+#endif
+
+       IF (is_root_prc) THEN
+          nbp_glo=sum(nbp_para_nb)
+          ALLOCATE(displs(0:mpi_size-1))
+	  ALLOCATE(index_l(nbp_glo))
+          displs(0)=0
+          DO i=1,mpi_size-1
+             displs(i)=displs(i-1)+nbp_para_nb(i-1)
+          ENDDO
+       ENDIF
+#ifdef CPP_PARA
+       CALL MPI_BCAST(nbp_glo,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+       CALL MPI_GATHERV(index_x,nbpoints,MPI_INT_ORCH,index_l,nbp_para_nb,displs,&
+            MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)  
+#else
+       ! if not parallized, nb_glo=nbpoints=nbp_para_nb
+       IF (is_root_prc) index_l(:)=index_x(1:nbp_glo)
+#endif
+    ELSE
+       IF (is_root_prc) THEN
+          nbp_glo=nbpoints
+          ALLOCATE(index_l(nbp_glo))
+          index_l(:)=index_x(1:nbp_glo)
+          CALL Read_Load_Balance(nbpoints,nbp_para_nb)
+       ENDIF
+    ENDIF
+
+    IF (is_root_prc) THEN
+
+       IF (check) WRITE(numout,*) '==== DISTRIB ====',nbpoints,nbp_para_nb
+
+       nbp_para_begin(0)=1
+       nbp_para_end(0)=nbp_para_nb(0)
+
+       DO i=1,mpi_size-1
+          nbp_para_begin(i)=nbp_para_end(i-1)+1
+          nbp_para_end(i)=nbp_para_begin(i)+nbp_para_nb(i)-1
+       ENDDO
+
+       nbp_loc=nbp_para_nb(mpi_rank)
+
+       iim_g=iim
+       jjm_g=jjm
+
+
+       ij_para_begin(0)=1
+       ij_para_end(0)=index_l(nbp_para_end(0))
+       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_end(i)=index_l(nbp_para_end(i))
+	  ij_para_nb(i)=ij_para_end(i)-ij_para_begin(i)+1
+       ENDDO
+
+       ij_para_end(mpi_size-1)=iim*jjm
+       ij_para_nb(mpi_size-1)=ij_para_end(mpi_size-1)-ij_para_begin(mpi_size-1)+1
+
+
+       DO i=0,mpi_size-1
+          jj_para_begin(i)=(ij_para_begin(i)-1)/iim + 1
+	  jj_para_end(i)=(ij_para_end(i)-1)/iim + 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)+1
+	  ii_para_end(i)=MOD(ij_para_end(i)-1,iim)+1
+       ENDDO
+
+       IF (check) THEN
+          WRITE(numout,*) '==== DECOUP ===='
+          WRITE(numout,*) 'nbp_para_begin=',nbp_para_begin
+          WRITE(numout,*) 'nbp_para_end  =',nbp_para_end
+          WRITE(numout,*) 'nbp_loc=',nbp_loc
+
+          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
+       ENDIF
+
+       !
+       !- Root need the global variables
+       !-
+       ALLOCATE(resolution_g(nbp_glo,2),area_g(nbp_glo),lalo_g(nbp_glo,2))
+       ALLOCATE(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))
+
+       index_g(:)=index_l(1:nbp_glo)
+    ENDIF
+
+#ifdef CPP_PARA
+    IF (is_root_prc) WRITE(numout,*) 'nbp_para_nb =',nbp_para_nb
+    CALL MPI_BCAST(nbp_para_nb,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(nbp_para_begin,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(nbp_para_end,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(jj_para_nb,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(jj_para_begin,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(jj_para_end,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(ii_para_begin,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(ii_para_end,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(ij_para_nb,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(ij_para_begin,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(ij_para_end,mpi_size,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(iim_g,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(jjm_g,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    CALL MPI_BCAST(nbp_glo,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+#endif
+
+    nbp_loc=nbp_para_nb(mpi_rank)
+
+    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)
+
+    IF (check) &
+         WRITE(numout,*) 'Init_io_para'
+    CALL Init_io_para
+
+    IF (is_root_prc ) THEN 
+       DEALLOCATE(index_l)
+       IF ( cpl_lmdz) THEN
+          DEALLOCATE(displs)
+       ENDIF
+    ENDIF
+
+    IF (check) &
+         WRITE(numout,*)  'DATA PARA',nbp_loc,nbp_glo,jj_begin,jj_end,ii_begin,ii_end       
+  END SUBROUTINE init_data_para
+  
+
+  SUBROUTINE Init_io_para
+    USE ioipsl
+    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 
+
+    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)
+  END SUBROUTINE Init_io_para
+  
+  SUBROUTINE Read_Load_balance(NbPoints,Nbpoints_loc)
+
+    IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: NbPoints
+    INTEGER,INTENT(OUT) :: Nbpoints_loc(0:mpi_size-1)
+#ifdef CPP_PARA  
+    INTEGER :: unit_number=10
+    CHARACTER(len=255)  :: filename='Load_balance_orchidee.dat'
+    INTEGER :: j
+#endif
+    INTEGER :: i,s,ierr
+    
+    Nbpoints_loc(:) = 0
+
+#ifdef CPP_PARA
+    OPEN(UNIT=unit_number,FILE=trim(filename),STATUS='old',FORM='formatted',IOSTAT=ierr) 
+#else
+    ierr=1
+#endif   
+    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(r_std),INTENT(IN) :: times
+  
+#ifdef CPP_PARA  
+    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)
+#endif
+    
+    WRITE(numout,*) 'time',times
+#ifndef CPP_PARA
+    RETURN
+#else
+
+    CALL MPI_GATHER(times,1,MPI_REAL_ORCH,All_times,1,MPI_REAL_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    IF (is_root_prc) WRITE(numout,*) 'ALL_times',All_times
+
+    IF (is_root_prc) 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_para_nb(i)
+          New_nbpoints(i)=Nbp_para_nb(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_para_nb(:)
+       ENDIF
+       
+       DO i=0,mpi_size-1
+          WRITE(Unit_number,*) i,New_nbpoints(i)
+       ENDDO
+       CLOSE(Unit_number)
+    ENDIF
+#endif
+ 
+  END SUBROUTINE Write_Load_Balance
+  
+  
+  
+END MODULE data_para
+
+#include "mpi_dummy.h"
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/ioipsl_para.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/ioipsl_para.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/ioipsl_para.f90	(revision 854)
@@ -0,0 +1,385 @@
+! Overlap of IOIPSL functions for specific parallel use in ORCHIDEE.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE ioipsl_para
+  USE ioipsl
+  USE data_para
+  USE transfert_para
+!-
+  IMPLICIT NONE
+!-
+#include "src_parallel.h"
+!-
+  INTERFACE getin_p
+    MODULE PROCEDURE getin_p_c,                      &
+         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
+
+CONTAINS
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!   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  
+
+!! -- 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) )
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    IF (is_root_prc) 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) )
+       CALL restget &
+            (fid, vname_q, iim, jjm, llm, itau, def_beha, &
+            temp_g, MY_OPERATOR, nbindex, ijndex)
+    ENDIF
+    CALL scatter(temp_g,var)
+    IF (is_root_prc) 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) )
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter(temp_g,var)
+    IF (is_root_prc) 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) )
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter(temp_g,var)
+    IF (is_root_prc) 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) )
+       CALL restget &
+            (fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
+    ENDIF
+    CALL scatter(temp_g,var)
+    IF (is_root_prc) 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) ALLOCATE( temp_g(iim*jjm*llm) )
+    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)
+
+       DEALLOCATE( temp_g )
+    ENDIF
+          
+  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) ALLOCATE( temp_g(iim,jjm) )
+    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)
+       DEALLOCATE( temp_g )
+    ENDIF
+          
+  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) ALLOCATE( temp_g(iim*jjm*llm) )
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+       DEALLOCATE( temp_g )
+    ENDIF
+          
+  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) ALLOCATE( temp_g(iim,jjm) )
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+       DEALLOCATE( temp_g )
+    ENDIF
+          
+  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) ALLOCATE( temp_g(iim,jjm,llm) )
+    CALL gather(var,temp_g)
+    IF (is_root_prc) THEN
+       CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
+       DEALLOCATE( temp_g )
+    ENDIF
+          
+  END SUBROUTINE restput_p_r3d
+
+END MODULE ioipsl_para
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/mpi_dummy.h
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/mpi_dummy.h	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/mpi_dummy.h	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/orch_write_field.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/orch_write_field.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/orch_write_field.f90	(revision 854)
@@ -0,0 +1,285 @@
+! Yann Meurdesoif functions for sequentiel tests.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+module orch_Write_Field
+  
+  USE data_para
+
+  IMPLICIT NONE
+
+!-
+#include "src_parallel.h"
+!-
+  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: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/orch_write_field_p.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/orch_write_field_p.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/orch_write_field_p.f90	(revision 854)
@@ -0,0 +1,159 @@
+! 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(index_Write_Field_p)
+  USE parallel
+  USE Write_Field, only : Init_WriteField
+  IMPLICIT NONE
+    INTEGER,INTENT(in) :: index_Write_Field_p(nbp_loc)
+
+    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 parallel
+    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(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 parallel
+    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(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 parallel
+    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(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 parallel
+    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 parallel
+    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 parallel
+    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: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/parallel.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/parallel.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/parallel.f90	(revision 854)
@@ -0,0 +1,17 @@
+! Global module for all parallel modules.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE PARALLEL
+
+  USE data_para
+  USE transfert_para
+  USE ioipsl_para
+  USE tools_para
+
+END MODULE PARALLEL
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/src_parallel.h
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/src_parallel.h	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/src_parallel.h	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/timer.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/timer.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/timer.f90	(revision 854)
@@ -0,0 +1,177 @@
+! Timer functions to calculate MPI use speed up.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE timer
+
+  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: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/tools_para.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/tools_para.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/tools_para.f90	(revision 854)
@@ -0,0 +1,55 @@
+! Parallel tools : Barrier and Finalize.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE tools_para
+!-
+  USE ioipsl
+  USE defprec
+  USE timer
+  USE data_para
+!-
+#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: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/transfert_para.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/transfert_para.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/transfert_para.f90	(revision 854)
@@ -0,0 +1,2949 @@
+! Low level parallel communication encapsulations for ORCHIDEE.
+
+!-
+!< $HeadURL$ 
+!< $Date$
+!< $Author$
+!< $Revision$
+!-
+
+MODULE transfert_para
+
+  USE data_para
+  USE timer
+!-
+  IMPLICIT NONE
+!-
+#include "src_parallel.h"
+!-
+
+  INTERFACE bcast
+    MODULE PROCEDURE bcast_c,                                     &
+                     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_s
+!!$    MODULE PROCEDURE gather_is, &
+!!$                     gather_rs, &
+!!$		     gather_ls
+!!$  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 scatter2D
+    MODULE PROCEDURE scatter2D_i,scatter2D_i1,scatter2D_i2,scatter2D_i3, &
+                     scatter2D_r0,scatter2D_r,scatter2D_r1,scatter2D_r2,scatter2D_r3, &
+		     scatter2D_l,scatter2D_l1,scatter2D_l2,scatter2D_l3
+  END INTERFACE
+
+  INTERFACE gather2D
+    MODULE PROCEDURE gather2D_i,gather2D_i1,gather2D_i2,gather2D_i3, &
+                     gather2D_r0,gather2D_r,gather2D_r1,gather2D_r2,gather2D_r3, &
+		     gather2D_l,gather2D_l1,gather2D_l2,gather2D_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(var1)
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var1
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_cgen(Var1,len(Var1))
+#endif
+  END SUBROUTINE bcast_c
+
+!! -- Les entiers -- !!
+  
+  SUBROUTINE bcast_i(var1)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var1
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_igen(Var1,1)
+#endif
+  END SUBROUTINE bcast_i
+
+  SUBROUTINE bcast_i1(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_i1
+
+  SUBROUTINE bcast_i2(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_i2
+
+  SUBROUTINE bcast_i3(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_i3
+
+  SUBROUTINE bcast_i4(var)
+  IMPLICIT NONE
+    INTEGER,INTENT(INOUT) :: Var(:,:,:,:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_igen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_i4
+
+
+!! -- Les reels -- !!
+
+  SUBROUTINE bcast_r(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_rgen(Var,1)
+#endif
+  END SUBROUTINE bcast_r
+
+  SUBROUTINE bcast_r1(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_r1
+
+  SUBROUTINE bcast_r2(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_r2
+
+  SUBROUTINE bcast_r3(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_r3
+
+  SUBROUTINE bcast_r4(var)
+  IMPLICIT NONE
+    REAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_rgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_r4
+  
+!! -- Les booleans -- !!
+
+  SUBROUTINE bcast_l(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var
+    LOGICAL,DIMENSION(1) :: Var1
+#ifndef CPP_PARA
+    RETURN
+#else
+    IF (is_root_prc) &
+         Var1(1)=Var
+    CALL bcast_lgen(Var1,1)
+    Var=Var1(1)
+#endif
+  END SUBROUTINE bcast_l
+
+  SUBROUTINE bcast_l1(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_l1
+
+  SUBROUTINE bcast_l2(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_l2
+
+  SUBROUTINE bcast_l3(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_l3
+
+  SUBROUTINE bcast_l4(var)
+  IMPLICIT NONE
+    LOGICAL,INTENT(INOUT) :: Var(:,:,:,:)
+   
+#ifndef CPP_PARA
+    RETURN
+#else
+    CALL bcast_lgen(Var,size(Var))
+#endif
+  END SUBROUTINE bcast_l4
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(nbp_glo) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_loc) :: VarOut
+
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+     IF (is_root_prc) THEN
+      CALL scatter_igen(VarIn,Varout,1)
+     ELSE
+      CALL scatter_igen(dummy,Varout,1)
+    ENDIF
+    
+#endif
+  END SUBROUTINE scatter_i
+
+  SUBROUTINE scatter_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+        
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_igen(VarIn,Varout,Size(VarOut,2))
+    ELSE
+      CALL scatter_igen(dummy,Varout,Size(VarOut,2))
+    ENDIF
+    
+#endif
+  END SUBROUTINE scatter_i1
+  
+  SUBROUTINE scatter_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+        
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+    ELSE
+      CALL scatter_igen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3))
+    ENDIF
+#endif
+  END SUBROUTINE scatter_i2
+
+  SUBROUTINE scatter_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+        
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_igen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+    ELSE
+      CALL scatter_igen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+    ENDIF
+  
+#endif
+  END SUBROUTINE scatter_i3
+
+
+  SUBROUTINE scatter_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_rgen(VarIn,Varout,1)
+    ELSE
+      CALL scatter_rgen(dummy,Varout,1)
+    ENDIF
+  
+#endif
+  END SUBROUTINE scatter_r
+
+  SUBROUTINE scatter_r1(VarIn, VarOut)
+
+  IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+        
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_rgen(VarIn,Varout,Size(VarOut,2))
+    ELSE
+      CALL scatter_rgen(dummy,Varout,Size(VarOut,2))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE scatter_r1
+  
+  SUBROUTINE scatter_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+    ELSE
+      CALL scatter_rgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3))
+    ENDIF
+  
+#endif
+  END SUBROUTINE scatter_r2
+
+  SUBROUTINE scatter_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_rgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+    ELSE
+      CALL scatter_rgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+    ENDIF
+  
+#endif
+  END SUBROUTINE scatter_r3
+
+
+  SUBROUTINE scatter_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+#ifdef CPP_PARA    
+    LOGICAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_lgen(VarIn,Varout,1)
+    ELSE
+      CALL scatter_lgen(dummy,Varout,1)
+    ENDIF
+    
+#endif
+  END SUBROUTINE scatter_l
+
+  SUBROUTINE scatter_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    LOGICAL :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_lgen(VarIn,Varout,Size(VarOut,2))
+    ELSE
+      CALL scatter_lgen(dummy,Varout,Size(VarOut,2))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE scatter_l1
+  
+  SUBROUTINE scatter_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    LOGICAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3))
+    ELSE
+      CALL scatter_lgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3))
+    ENDIF
+  
+#endif
+  END SUBROUTINE scatter_l2
+
+  SUBROUTINE scatter_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    LOGICAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+    IF (is_root_prc) THEN
+      CALL scatter_lgen(VarIn,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+    ELSE
+      CALL scatter_lgen(dummy,Varout,Size(VarOut,2)*Size(VarOut,3)*Size(VarOut,4))
+    ENDIF
+  
+#endif
+  END SUBROUTINE scatter_l3  
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!$  SUBROUTINE gather_is(VarIn, VarOut)
+!!$    USE data_para
+!!$    USE timer
+!!$
+!!$    IMPLICIT NONE
+!!$  
+!!$#ifdef CPP_PARA
+!!$    INCLUDE 'mpif.h'
+!!$#endif
+!!$    
+!!$    INTEGER,INTENT(IN) :: VarIn
+!!$    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+!!$  
+!!$#ifdef CPP_PARA
+!!$    INTEGER :: nb,i,index_para,rank
+!!$    INTEGER :: 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_rgen VarIn=",VarIn    
+!!$
+!!$#ifdef CPP_PARA
+!!$    CALL MPI_GATHER(VarIn,1,MPI_INT_ORCH,VarOut,1,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+!!$#endif
+!!$
+!!$    IF (check) &
+!!$         WRITE(numout,*) "gather_rgen VarOut=",VarOut
+!!$    IF (flag) CALL resume_timer(timer_mpi)
+!!$#endif
+!!$  END SUBROUTINE gather_is
+!!$
+!!$  SUBROUTINE gather_rs(VarIn, VarOut)
+!!$    USE data_para
+!!$    USE timer
+!!$
+!!$    IMPLICIT NONE
+!!$  
+!!$#ifdef CPP_PARA
+!!$    INCLUDE 'mpif.h'
+!!$#endif
+!!$
+!!$    REAL,INTENT(IN) :: VarIn
+!!$    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+!!$  
+!!$#ifdef CPP_PARA
+!!$    INTEGER :: nb,i,index_para,rank
+!!$    INTEGER :: 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_rgen VarIn=",VarIn    
+!!$
+!!$#ifdef CPP_PARA
+!!$    CALL MPI_GATHER(VarIn,1,MPI_REAL_ORCH,VarOut,1,MPI_REAL_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+!!$#endif
+!!$
+!!$    IF (check) &
+!!$         WRITE(numout,*) "gather_rgen VarOut=",VarOut
+!!$
+!!$    IF (flag) CALL resume_timer(timer_mpi)
+!!$#endif
+!!$  END SUBROUTINE gather_rs
+!!$
+!!$  SUBROUTINE gather_ls(VarIn, VarOut)
+!!$    USE data_para
+!!$    USE timer
+!!$
+!!$    IMPLICIT NONE
+!!$  
+!!$#ifdef CPP_PARA
+!!$    INCLUDE 'mpif.h'
+!!$#endif
+!!$    
+!!$    LOGICAL,INTENT(IN) :: VarIn
+!!$    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+!!$  
+!!$#ifdef CPP_PARA
+!!$    INTEGER :: nb,i,index_para,rank
+!!$    INTEGER :: 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_rgen VarIn=",VarIn    
+!!$
+!!$#ifdef CPP_PARA
+!!$    CALL MPI_GATHER(VarIn,1,MPI_LOGICAL,VarOut,1,MPI_LOGICAL,root_prc,MPI_COMM_ORCH,ierr)
+!!$#endif
+!!$
+!!$    IF (check) &
+!!$         WRITE(numout,*) "gather_rgen VarOut=",VarOut
+!!$    IF (flag) CALL resume_timer(timer_mpi)
+!!$#endif
+!!$  END SUBROUTINE gather_ls
+
+!!!!! --> Les entiers
+
+  SUBROUTINE gather_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+!    if (SIZE(VarIn) == 1) call stopit
+    IF (is_root_prc) THEN
+      CALL gather_igen(VarIn,VarOut,1)
+    ELSE
+      CALL gather_igen(VarIn,dummy,1)
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_i
+
+!!!!!
+
+  SUBROUTINE gather_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+!    if (SIZE(VarIn) == 1) stop
+    IF (is_root_prc) THEN
+      CALL gather_igen(VarIn,VarOut,Size(VarIn,2))
+    ELSE
+      CALL gather_igen(VarIn,dummy,Size(VarIn,2))
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_i1
+
+!!!!!
+  
+  SUBROUTINE gather_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+    ELSE
+      CALL gather_igen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3))
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_i2
+
+!!!!!
+
+  SUBROUTINE gather_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather_igen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+    ELSE
+      CALL gather_igen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_i3
+
+!!!!! --> Les reels
+
+  SUBROUTINE gather_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+!    if (SIZE(VarIn) == 1) call stopit
+    IF (is_root_prc) THEN
+      CALL gather_rgen(VarIn,VarOut,1)
+    ELSE
+      CALL gather_rgen(VarIn,dummy,1)
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_r
+
+!!!!!
+
+  SUBROUTINE gather_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather_rgen(VarIn,VarOut,Size(VarIn,2))
+    ELSE
+      CALL gather_rgen(VarIn,dummy,Size(VarIn,2))
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_r1
+
+!!!!!
+  
+  SUBROUTINE gather_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+    ELSE
+      CALL gather_rgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_r2
+
+!!!!!
+
+  SUBROUTINE gather_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather_rgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+    ELSE
+      CALL gather_rgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_r3
+
+!!!!! --> Les booleen
+
+  SUBROUTINE gather_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+#ifdef CPP_PARA
+    LOGICAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+!    if (SIZE(VarIn) == 1) call stopit
+    IF (is_root_prc) THEN
+      CALL gather_lgen(VarIn,VarOut,1)
+    ELSE
+      CALL gather_lgen(VarIn,dummy,1)      
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_l
+
+!!!!!
+
+  SUBROUTINE gather_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    LOGICAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather_lgen(VarIn,VarOut,Size(VarIn,2))
+    ELSE
+      CALL gather_lgen(VarIn,dummy,Size(VarIn,2))
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_l1
+
+!!!!!
+  
+  SUBROUTINE gather_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    LOGICAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3))
+    ELSE
+      CALL gather_lgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3))
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_l2
+
+!!!!!
+
+  SUBROUTINE gather_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    LOGICAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather_lgen(VarIn,VarOut,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
+    ELSE
+      CALL gather_lgen(VarIn,dummy,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE gather_l3
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Scatter2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE scatter2D_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_igen(VarIn,VarOut,1)
+    ELSE
+      CALL scatter2D_igen(dummy,VarOut,1)
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_i
+
+  SUBROUTINE scatter2D_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_igen(VarIn,VarOut,SIZE(VarOut,3))
+    ELSE
+      CALL scatter2D_igen(dummy,VarOut,SIZE(VarOut,3))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_i1
+
+  SUBROUTINE scatter2D_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_igen(VarIn,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+      CALL scatter2D_igen(dummy,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_i2
+  
+  SUBROUTINE scatter2D_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_igen(VarIn,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+      CALL scatter2D_igen(dummy,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_i3
+
+
+  SUBROUTINE scatter2D_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_rgen(VarIn,VarOut,1)
+    ELSE
+      CALL scatter2D_rgen(dummy,VarOut,1)      
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_r0
+
+  SUBROUTINE scatter2D_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_rgen(VarIn,VarOut,1)
+    ELSE
+      CALL scatter2D_rgen(dummy,VarOut,1)      
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_r
+
+  SUBROUTINE scatter2D_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_rgen(VarIn,VarOut,SIZE(VarOut,3))
+    ELSE
+      CALL scatter2D_rgen(dummy,VarOut,SIZE(VarOut,3))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_r1
+
+  SUBROUTINE scatter2D_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_rgen(VarIn,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+      CALL scatter2D_rgen(dummy,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_r2
+  
+  SUBROUTINE scatter2D_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_rgen(VarIn,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+      CALL scatter2D_rgen(dummy,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_r3  
+  
+  
+  SUBROUTINE scatter2D_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    LOGICAL :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_lgen(VarIn,VarOut,1)
+    ELSE
+      CALL scatter2D_lgen(dummy,VarOut,1)
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_l
+
+  SUBROUTINE scatter2D_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA    
+    LOGICAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_lgen(VarIn,VarOut,SIZE(VarOut,3))
+    ELSE
+      CALL scatter2D_lgen(dummy,VarOut,SIZE(VarOut,3))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE scatter2D_l1
+
+  SUBROUTINE scatter2D_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    LOGICAL :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_lgen(VarIn,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ELSE
+      CALL scatter2D_lgen(dummy,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4))
+    ENDIF
+  
+#endif
+  END SUBROUTINE scatter2D_l2
+  
+  SUBROUTINE scatter2D_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    LOGICAL :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL scatter2D_lgen(VarIn,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ELSE
+      CALL scatter2D_lgen(dummy,VarOut,SIZE(VarOut,3)*SIZE(VarOut,4)*SIZE(VarOut,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE scatter2D_l3 
+  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des Gather2D   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE gather2D_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_igen(VarIn,VarOut,1)
+    ELSE
+      CALL gather2D_igen(VarIn,dummy,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_i
+
+  SUBROUTINE gather2D_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_igen(VarIn,VarOut,SIZE(VarIn,3))
+    ELSE
+      CALL gather2D_igen(VarIn,dummy,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_i1
+
+  SUBROUTINE gather2D_i2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_igen(VarIn,VarOut,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+      CALL gather2D_igen(VarIn,dummy,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_i2
+  
+  SUBROUTINE gather2D_i3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_igen(VarIn,VarOut,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+      CALL gather2D_igen(VarIn,dummy,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_i3
+
+
+  SUBROUTINE gather2D_r0(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_rgen(VarIn,VarOut,1)
+    ELSE
+      CALL gather2D_rgen(VarIn,dummy,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_r0
+
+  SUBROUTINE gather2D_r(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_rgen(VarIn,VarOut,1)
+    ELSE
+      CALL gather2D_rgen(VarIn,dummy,1)
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_r
+
+  SUBROUTINE gather2D_r1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_rgen(VarIn,VarOut,SIZE(VarIn,3))
+    ELSE
+      CALL gather2D_rgen(VarIn,dummy,SIZE(VarIn,3))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_r1
+
+  SUBROUTINE gather2D_r2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_rgen(VarIn,VarOut,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+      CALL gather2D_rgen(VarIn,dummy,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+
+#endif
+  END SUBROUTINE gather2D_r2
+  
+  SUBROUTINE gather2D_r3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_rgen(VarIn,VarOut,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+      CALL gather2D_rgen(VarIn,dummy,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE gather2D_r3  
+  
+  
+  SUBROUTINE gather2D_l(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_lgen(VarIn,VarOut,1)
+    ELSE
+      CALL gather2D_lgen(VarIn,dummy,1)
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE gather2D_l
+
+  SUBROUTINE gather2D_l1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA    
+    LOGICAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_lgen(VarIn,VarOut,SIZE(VarIn,3))
+    ELSE
+      CALL gather2D_lgen(VarIn,dummy,SIZE(VarIn,3))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE gather2D_l1
+
+  SUBROUTINE gather2D_l2(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+
+#ifdef CPP_PARA    
+    LOGICAL :: dummy
+#endif
+
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_lgen(VarIn,VarOut,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ELSE
+      CALL gather2D_lgen(VarIn,dummy,SIZE(VarIn,3)*SIZE(VarIn,4))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE gather2D_l2
+  
+  SUBROUTINE gather2D_l3(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    LOGICAL,INTENT(IN),DIMENSION(:,:,:,:,:) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(:,:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA    
+    LOGICAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:,:)=VarIn(:,:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL gather2D_lgen(VarIn,VarOut,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ELSE
+      CALL gather2D_lgen(VarIn,dummy,SIZE(VarIn,3)*SIZE(VarIn,4)*SIZE(VarIn,5))
+    ENDIF
+  
+
+#endif
+  END SUBROUTINE gather2D_l3  
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Definition des reduce_sum   --> 4D   !!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE reduce_sum_i(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN)  :: VarIn
+    INTEGER,INTENT(OUT) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut=VarIn
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL reduce_sum_igen(VarIn,Varout,1)
+    ELSE
+      CALL reduce_sum_igen(VarIn,dummy,1)
+    ENDIF
+  
+#endif
+  END SUBROUTINE reduce_sum_i
+
+  SUBROUTINE reduce_sum_i1(VarIn, VarOut)
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL reduce_sum_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+      CALL reduce_sum_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE reduce_sum_i1
+
+  SUBROUTINE reduce_sum_i2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL reduce_sum_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+      CALL reduce_sum_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE reduce_sum_i2
+
+  SUBROUTINE reduce_sum_i3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL reduce_sum_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+      CALL reduce_sum_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE reduce_sum_i3
+
+  SUBROUTINE reduce_sum_i4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    INTEGER :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL reduce_sum_igen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+      CALL reduce_sum_igen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE reduce_sum_i4                  
+  
+  
+  SUBROUTINE reduce_sum_r(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN)  :: VarIn
+    REAL,INTENT(OUT) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut=VarIn
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL reduce_sum_rgen(VarIn,Varout,1)
+    ELSE
+      CALL reduce_sum_rgen(VarIn,dummy,1)
+    ENDIF
+  
+#endif
+  END SUBROUTINE reduce_sum_r
+
+  SUBROUTINE reduce_sum_r1(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:)=VarIn(:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL reduce_sum_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+      CALL reduce_sum_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE reduce_sum_r1
+
+  SUBROUTINE reduce_sum_r2(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:)=VarIn(:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL reduce_sum_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+      CALL reduce_sum_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE reduce_sum_r2
+
+  SUBROUTINE reduce_sum_r3(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:)=VarIn(:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL reduce_sum_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+      CALL reduce_sum_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE reduce_sum_r3
+
+  SUBROUTINE reduce_sum_r4(VarIn, VarOut)
+    IMPLICIT NONE
+  
+    REAL,INTENT(IN),DIMENSION(:,:,:,:)  :: VarIn
+    REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
+    
+#ifdef CPP_PARA
+    REAL :: dummy
+#endif
+    
+#ifndef CPP_PARA
+    VarOut(:,:,:,:)=VarIn(:,:,:,:)
+    RETURN
+#else
+
+    IF (is_root_prc) THEN
+      CALL reduce_sum_rgen(VarIn,Varout,SIZE(VarIn))
+    ELSE
+      CALL reduce_sum_rgen(VarIn,dummy,SIZE(VarIn))      
+    ENDIF
+  
+#endif
+  END SUBROUTINE reduce_sum_r4 
+  
+                            
+END MODULE transfert_para    
+
+#ifdef CPP_PARA
+
+  SUBROUTINE bcast_cgen(var,nb)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+    
+    CHARACTER(LEN=*),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+    INCLUDE 'mpif.h'
+
+    INTEGER :: 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,*) "bcast_cgen before bcast Var",Var
+    IF (flag) CALL suspend_timer(timer_mpi)
+    CALL MPI_BCAST(Var,nb,MPI_CHARACTER,root_prc,MPI_COMM_ORCH,ierr)
+    IF (flag) CALL resume_timer(timer_mpi)
+    IF (check) &
+         WRITE(numout,*) "bcast_cgen after bcast Var",Var
+        
+  END SUBROUTINE bcast_cgen
+      
+  SUBROUTINE bcast_igen(var,nb)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+    
+    INTEGER,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+    INCLUDE 'mpif.h'
+
+    INTEGER :: 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,*) "bcast_igen before bcast Var",Var
+    CALL MPI_BCAST(Var,nb,MPI_INT_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    IF (flag) CALL resume_timer(timer_mpi)
+    IF (check) &
+         WRITE(numout,*) "bcast_igen after bcast Var",Var    
+        
+  END SUBROUTINE bcast_igen
+  
+  SUBROUTINE bcast_rgen(var,nb)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+    
+    REAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+    INCLUDE 'mpif.h'
+
+    INTEGER :: 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,*) "bcast_rgen before bcast Var",Var
+    IF (flag) CALL suspend_timer(timer_mpi)    
+    CALL MPI_BCAST(Var,nb,MPI_REAL_ORCH,root_prc,MPI_COMM_ORCH,ierr)
+    IF (flag) CALL resume_timer(timer_mpi)
+    IF (check) &
+         WRITE(numout,*) "bcast_rgen after bcast Var",Var
+    
+  END SUBROUTINE bcast_rgen
+  
+  SUBROUTINE bcast_lgen(var,nb)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+    
+    LOGICAL,DIMENSION(nb),INTENT(INOUT) :: Var
+    INTEGER,INTENT(IN) :: nb
+    
+    INCLUDE 'mpif.h'
+
+    INTEGER :: 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,*) "bcast_lgen before bcast Var",Var
+    IF (flag) CALL suspend_timer(timer_mpi)    
+    CALL MPI_BCAST(Var,nb,MPI_LOGICAL,root_prc,MPI_COMM_ORCH,ierr)
+    IF (flag) CALL resume_timer(timer_mpi)
+    IF (check) &
+         WRITE(numout,*) "bcast_lgen after bcast Var",Var
+
+  END SUBROUTINE bcast_lgen
+
+  
+  SUBROUTINE scatter_igen(VarIn, VarOut, dimsize)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(nbp_glo,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_loc,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*nbp_glo) :: VarTmp
+    
+    INTEGER :: nb,i,index_para,rank
+    INTEGER :: 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_root_prc) THEN
+      Index_Para=1
+      DO rank=0,mpi_size-1
+        nb=nbp_para_nb(rank)
+        displs(rank)=Index_Para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index_Para:Index_Para+nb-1)=VarIn(nbp_para_begin(rank):nbp_para_end(rank),i)
+          Index_Para=Index_Para+nb
+        ENDDO
+      ENDDO
+      IF (check) THEN
+         WRITE(numout,*) "scatter_igen VarIn",VarIn
+         WRITE(numout,*) "scatter_igen VarTmp",VarTmp
+      ENDIF
+    ENDIF
+      
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_INT_ORCH,VarOut,nbp_loc*dimsize,   &
+                      MPI_INT_ORCH,root_prc, MPI_COMM_ORCH,ierr)
+    IF (flag) CALL resume_timer(timer_mpi)
+    IF (check) &
+       WRITE(numout,*) "scatter_igen VarOut",VarOut
+
+  END SUBROUTINE scatter_igen
+
+  SUBROUTINE scatter_rgen(VarIn, VarOut, dimsize)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(nbp_glo,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_loc,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
+    
+    INTEGER :: nb,i,index_para,rank
+    INTEGER :: 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_root_prc) THEN
+      Index_Para=1
+      DO rank=0,mpi_size-1
+        nb=nbp_para_nb(rank)
+        displs(rank)=Index_Para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index_Para:Index_Para+nb-1)=VarIn(nbp_para_begin(rank):nbp_para_end(rank),i)
+          Index_Para=Index_Para+nb
+        ENDDO
+      ENDDO
+      IF (check) THEN
+         WRITE(numout,*) "scatter_rgen VarIn",VarIn
+         WRITE(numout,*) "scatter_rgen VarTmp",VarTmp
+      ENDIF
+    ENDIF
+      
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_REAL_ORCH,VarOut,nbp_loc*dimsize,   &
+                      MPI_REAL_ORCH,root_prc, MPI_COMM_ORCH,ierr)
+
+    IF (flag) CALL resume_timer(timer_mpi)
+    IF (check) &
+       WRITE(numout,*) "scatter_rgen VarOut",VarOut
+
+  END SUBROUTINE scatter_rgen
+  
+  SUBROUTINE scatter_lgen(VarIn, VarOut, dimsize)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(nbp_glo,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_loc,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
+    
+    INTEGER :: nb,i,index_para,rank
+    INTEGER :: 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_root_prc) THEN
+      Index_Para=1
+      DO rank=0,mpi_size-1
+        nb=nbp_para_nb(rank)
+        displs(rank)=Index_Para-1
+        counts(rank)=nb*dimsize
+        DO i=1,dimsize
+          VarTmp(Index_Para:Index_Para+nb-1)=VarIn(nbp_para_begin(rank):nbp_para_end(rank),i)
+          Index_Para=Index_Para+nb
+        ENDDO
+      ENDDO
+      IF (check) THEN
+         WRITE(numout,*) "scatter_lgen VarIn",VarIn
+         WRITE(numout,*) "scatter_lgen VarTmp",VarTmp
+      ENDIF
+    ENDIF
+      
+    CALL MPI_SCATTERV(VarTmp,counts,displs,MPI_LOGICAL,VarOut,nbp_loc*dimsize,   &
+                      MPI_LOGICAL,root_prc, MPI_COMM_ORCH,ierr)
+    IF (flag) CALL resume_timer(timer_mpi)
+    IF (check) &
+       WRITE(numout,*) "scatter_lgen VarOut",VarOut
+
+  END SUBROUTINE scatter_lgen  
+
+  SUBROUTINE gather_igen(VarIn, VarOut, dimsize)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(nbp_loc,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(nbp_glo,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+    
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(dimsize*nbp_glo) :: VarTmp
+    
+    INTEGER :: nb,i,index_para,rank
+    INTEGER :: 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_root_prc) THEN
+      Index_Para=1
+      IF (check) &
+           WRITE(numout,*) "gather_igen mpi_size, dimsize, nbp_glo",mpi_size, dimsize, nbp_glo
+      DO rank=0,mpi_size-1
+        nb=nbp_para_nb(rank)
+        displs(rank)=Index_Para-1
+        counts(rank)=nb*dimsize
+	Index_Para=Index_Para+nb*dimsize
+      ENDDO
+       IF (check) &
+            WRITE(numout,*) "gather_igen nbp_para_nb, displs, counts,Index_Para-1",nbp_para_nb, displs, counts,Index_Para-1
+     
+    ENDIF
+    
+    IF (check) &
+         WRITE(numout,*) "gather_igen VarIn=",VarIn    
+    CALL MPI_GATHERV(VarIn,nbp_loc*dimsize,MPI_INT_ORCH,VarTmp,counts,displs,   &
+         MPI_INT_ORCH,root_prc, MPI_COMM_ORCH,ierr)
+
+    IF (check) &
+         WRITE(numout,*) "gather_igen dimsize,VarTmp=",dimsize,VarTmp
+		          
+    IF (is_root_prc) THEN
+      Index_Para=1
+      DO rank=0,mpi_size-1
+        nb=nbp_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(nbp_para_begin(rank):nbp_para_end(rank),i)=VarTmp(Index_Para:Index_Para+nb-1)
+	  Index_Para=Index_Para+nb
+        ENDDO
+      ENDDO
+    ENDIF
+    IF (check) &
+         WRITE(numout,*) "gather_igen VarOut=",VarOut
+    IF (flag) CALL resume_timer(timer_mpi)
+
+  END SUBROUTINE gather_igen  
+
+  SUBROUTINE gather_rgen(VarIn, VarOut, dimsize)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+    
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(nbp_loc,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(nbp_glo,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
+    
+    INTEGER :: nb,i,index_para,rank
+    INTEGER :: 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_root_prc) THEN
+      Index_Para=1
+      IF (check) &
+           WRITE(numout,*) "gather_rgen mpi_size, dimsize, nbp_glo",mpi_size, dimsize, nbp_glo
+      DO rank=0,mpi_size-1
+        nb=nbp_para_nb(rank)
+        displs(rank)=Index_Para-1
+        counts(rank)=nb*dimsize
+	Index_Para=Index_Para+nb*dimsize
+      ENDDO
+      IF (check) &
+           WRITE(numout,*) "gather_rgen nbp_para_nb, displs, counts,Index_Para-1",nbp_para_nb, displs, counts,Index_Para-1
+     
+    ENDIF
+    
+    IF (check) &
+         WRITE(numout,*) "gather_rgen VarIn=",VarIn    
+    CALL MPI_GATHERV(VarIn,nbp_loc*dimsize,MPI_REAL_ORCH,VarTmp,counts,displs,   &
+                      MPI_REAL_ORCH,root_prc, MPI_COMM_ORCH,ierr)
+    IF (check) &
+         WRITE(numout,*) "gather_rgen dimsize,VarTmp=",dimsize,VarTmp
+		          
+    IF (is_root_prc) THEN
+      Index_Para=1
+      DO rank=0,mpi_size-1
+        nb=nbp_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(nbp_para_begin(rank):nbp_para_end(rank),i)=VarTmp(Index_Para:Index_Para+nb-1)
+	  Index_Para=Index_Para+nb
+        ENDDO
+      ENDDO
+    ENDIF
+    IF (check) &
+         WRITE(numout,*) "gather_rgen VarOut=",VarOut
+    IF (flag) CALL resume_timer(timer_mpi)
+
+  END SUBROUTINE gather_rgen  
+
+  SUBROUTINE gather_lgen(VarIn, VarOut, dimsize)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(nbp_loc,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(nbp_glo,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(dimsize*nbp_glo) :: VarTmp
+    
+    INTEGER :: nb,i,index_para,rank
+    INTEGER :: 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_root_prc) THEN
+      Index_Para=1
+      IF (check) &
+           WRITE(numout,*) "gather_lgen mpi_size, dimsize, nbp_glo",mpi_size, dimsize, nbp_glo
+      DO rank=0,mpi_size-1
+        nb=nbp_para_nb(rank)
+        displs(rank)=Index_Para-1
+        counts(rank)=nb*dimsize
+	Index_Para=Index_Para+nb*dimsize
+      ENDDO
+      IF (check) &
+           WRITE(numout,*) "gather_lgen nbp_para_nb, displs, counts,Index_Para-1",nbp_para_nb, displs, counts,Index_Para-1
+    ENDIF
+    
+    IF (check) &
+         WRITE(numout,*) "gather_lgen VarIn=",VarIn    
+    CALL MPI_GATHERV(VarIn,nbp_loc*dimsize,MPI_LOGICAL,VarTmp,counts,displs,   &
+                      MPI_LOGICAL,root_prc, MPI_COMM_ORCH,ierr)
+    IF (check) &
+         WRITE(numout,*) "gather_lgen dimsize,VarTmp=",dimsize,VarTmp
+		          
+    IF (is_root_prc) THEN
+      Index_Para=1
+      DO rank=0,mpi_size-1
+        nb=nbp_para_nb(rank)
+        DO i=1,dimsize
+          VarOut(nbp_para_begin(rank):nbp_para_end(rank),i)=VarTmp(Index_Para:Index_Para+nb-1)
+	  Index_Para=Index_Para+nb
+        ENDDO
+      ENDDO
+    ENDIF
+    IF (check) &
+         WRITE(numout,*) "gather_lgen VarOut=",VarOut
+    IF (flag) CALL resume_timer(timer_mpi)
+
+  END SUBROUTINE gather_lgen
+  
+
+  SUBROUTINE scatter2D_igen(VarIn, VarOut, dimsize)
+    USE data_para, iim=>iim_g,jjm=>jjm_g
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(iim*jjm,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+
+    INTEGER,DIMENSION(0:mpi_size-1)   :: displs
+    INTEGER,DIMENSION(0:mpi_size-1)   :: counts
+    INTEGER,DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+    INTEGER,DIMENSION(ij_nb,dimsize)     :: VarTmp2
+    
+    INTEGER :: nb,i,ij,index_para,rank
+    INTEGER :: 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_root_prc) 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,*) "scatter2D_igen VarIn",VarIn
+         WRITE(numout,*) "scatter2D_igen VarTmp1",VarTmp1
+      ENDIF
+    ENDIF
+      
+    CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_INT_ORCH,VarTmp2,ij_nb*dimsize,   &
+                      MPI_INT_ORCH,root_prc, MPI_COMM_ORCH,ierr)
+    IF (check) &
+         WRITE(numout,*) "scatter2D_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,*) "scatter2D_igen VarOut",VarOut
+
+  END SUBROUTINE scatter2D_igen
+  
+  
+  SUBROUTINE scatter2D_rgen(VarIn, VarOut, dimsize)
+    USE data_para, iim=>iim_g,jjm=>jjm_g
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(iim*jjm,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+
+    INTEGER,DIMENSION(0:mpi_size-1)   :: displs
+    INTEGER,DIMENSION(0:mpi_size-1)   :: counts
+    REAL,DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+    REAL,DIMENSION(ij_nb,dimsize)     :: VarTmp2
+    REAL,DIMENSION(iim*jj_nb,dimsize) :: VarOut_bis
+    
+    INTEGER :: nb,i,ij,index_para,rank
+    INTEGER :: 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_root_prc) 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,*) "scatter2D_rgen VarIn",VarIn
+         WRITE(numout,*) "scatter2D_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,root_prc, MPI_COMM_ORCH,ierr)
+    IF (check) &
+         WRITE(numout,*) "scatter2D_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,*) "scatter2D_rgen VarOut",VarOut
+
+  END SUBROUTINE scatter2D_rgen
+
+  SUBROUTINE scatter2D_lgen(VarIn, VarOut, dimsize)
+    USE data_para, iim=>iim_g,jjm=>jjm_g
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(iim*jjm,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(iim*jj_nb,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+
+    INTEGER,DIMENSION(0:mpi_size-1)   :: displs
+    INTEGER,DIMENSION(0:mpi_size-1)   :: counts
+    LOGICAL,DIMENSION(dimsize*iim*jjm)   :: VarTmp1
+    LOGICAL,DIMENSION(ij_nb,dimsize)     :: VarTmp2
+    
+    INTEGER :: nb,i,ij,index_para,rank
+    INTEGER :: 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_root_prc) 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,*) "scatter2D_lgen VarIn",VarIn
+         WRITE(numout,*) "scatter2D_lgen VarTmp1",VarTmp1
+      ENDIF
+    ENDIF
+      
+    CALL MPI_SCATTERV(VarTmp1,counts,displs,MPI_LOGICAL,VarTmp2,ij_nb*dimsize,   &
+                      MPI_LOGICAL,root_prc, MPI_COMM_ORCH,ierr)
+    IF (check) &
+         WRITE(numout,*) "scatter2D_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,*) "scatter2D_lgen VarOut",VarOut
+
+  END SUBROUTINE scatter2D_lgen
+
+
+  SUBROUTINE gather2D_igen(VarIn, VarOut, dimsize)
+    USE data_para, iim=>iim_g,jjm=>jjm_g
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    INTEGER,INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn
+    INTEGER,INTENT(OUT),DIMENSION(iim*jjm,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    INTEGER,DIMENSION(ij_nb,dimsize)   :: VarTmp1
+    INTEGER,DIMENSION(dimsize*iim*jjm) :: VarTmp2
+    
+    INTEGER :: nb,i,ij,index_para,rank
+    INTEGER :: 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_root_prc) THEN
+      Index_Para=1
+      IF (check) &
+           WRITE(numout,*) "gather2D_igen mpi_size, dimsize, nbp_glo",mpi_size, dimsize, nbp_glo
+      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,*) "gather2D_igen nbp_para_nb, displs, counts,Index_Para-1",nbp_para_nb, 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,*) "gather2D_igen VarIn=",VarIn    
+       WRITE(numout,*) "gather2D_igen VarTmp1=",VarTmp1
+    ENDIF
+    CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_INT_ORCH,VarTmp2,counts,displs,   &
+                     MPI_INT_ORCH,root_prc, MPI_COMM_ORCH,ierr)
+    IF (check) &
+       WRITE(numout,*) "gather2D_igen VarTmp2=",VarTmp2
+		          
+    IF (is_root_prc) 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,*) "gather2D_igen VarOut=",VarOut
+
+  END SUBROUTINE gather2D_igen   
+
+
+  
+  SUBROUTINE gather2D_rgen(VarIn, VarOut, dimsize)
+    USE data_para, iim=>iim_g,jjm=>jjm_g
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    REAL,INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn
+    REAL,INTENT(OUT),DIMENSION(iim*jjm,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    REAL,DIMENSION(ij_nb,dimsize)   :: VarTmp1
+    REAL,DIMENSION(dimsize*iim*jjm) :: VarTmp2
+    
+    INTEGER :: nb,i,ij,index_para,rank
+    INTEGER :: 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_root_prc) THEN
+      Index_Para=1
+      IF (check) &
+           WRITE(numout,*) "gather2D_rgen mpi_size, dimsize, nbp_glo",mpi_size, dimsize, nbp_glo
+      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,*) "gather2D_rgen nbp_para_nb, displs, counts,Index_Para-1",nbp_para_nb, 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,*) "gather2D_rgen VarIn=",VarIn    
+       WRITE(numout,*) "gather2D_rgen VarTmp1=",VarTmp1
+    ENDIF
+    CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_REAL_ORCH,VarTmp2,counts,displs,   &
+                     MPI_REAL_ORCH,root_prc, MPI_COMM_ORCH,ierr)
+    IF (check) &
+       WRITE(numout,*) "gather2D_rgen VarTmp2=",VarTmp2
+
+    IF (is_root_prc) 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,*) "gather2D_rgen VarOut=",VarOut
+
+  END SUBROUTINE gather2D_rgen   
+
+  SUBROUTINE gather2D_lgen(VarIn, VarOut, dimsize)
+    USE data_para, iim=>iim_g,jjm=>jjm_g
+    USE timer
+
+    IMPLICIT NONE
+  
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(iim*jj_nb,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(iim*jjm,dimsize) :: VarOut
+  
+    INCLUDE 'mpif.h'
+  
+    INTEGER,DIMENSION(0:mpi_size-1) :: displs
+    INTEGER,DIMENSION(0:mpi_size-1) :: counts
+    LOGICAL,DIMENSION(ij_nb,dimsize)   :: VarTmp1
+    LOGICAL,DIMENSION(dimsize*iim*jjm) :: VarTmp2
+    
+    INTEGER :: nb,i,ij,index_para,rank
+    INTEGER :: 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_root_prc) THEN
+      Index_Para=1
+      IF (check) &
+           WRITE(numout,*) "gather2D_lgen mpi_size, dimsize, nbp_glo",mpi_size, dimsize, nbp_glo
+      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,*) "gather2D_lgen nbp_para_nb, displs, counts,Index_Para-1",nbp_para_nb, 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,*) "gather2D_lgen VarIn=",VarIn    
+       WRITE(numout,*) "gather2D_lgen VarTmp1=",VarTmp1
+    ENDIF
+    CALL MPI_GATHERV(VarTmp1,ij_nb*dimsize,MPI_LOGICAL,VarTmp2,counts,displs,   &
+                     MPI_LOGICAL,root_prc, MPI_COMM_ORCH,ierr)
+    IF (check) &
+       WRITE(numout,*) "gather2D_lgen VarTmp2=",VarTmp2
+		          
+    IF (is_root_prc) 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,*) "gather2D_lgen VarOut=",VarOut
+
+  END SUBROUTINE gather2D_lgen   
+
+  SUBROUTINE reduce_sum_igen(VarIn,VarOut,nb)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+    
+    INTEGER,DIMENSION(nb),INTENT(IN) :: VarIn
+    INTEGER,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER,INTENT(IN) :: nb
+    
+    INCLUDE 'mpif.h'
+
+    INTEGER :: 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,*) "reduce_sum_igen VarIn",VarIn
+    IF (flag) CALL suspend_timer(timer_mpi)
+   
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_INT_ORCH,MPI_SUM,root_prc,MPI_COMM_ORCH,ierr)
+            
+    IF (flag) CALL resume_timer(timer_mpi)
+    IF (check) &
+       WRITE(numout,*) "reduce_sum_igen VarOut",VarOut
+
+  END SUBROUTINE reduce_sum_igen
+  
+  SUBROUTINE reduce_sum_rgen(VarIn,VarOut,nb)
+    USE data_para
+    USE timer
+
+    IMPLICIT NONE
+    
+    REAL,DIMENSION(nb),INTENT(IN) :: VarIn
+    REAL,DIMENSION(nb),INTENT(OUT) :: VarOut    
+    INTEGER,INTENT(IN) :: nb
+
+    INCLUDE 'mpif.h'
+    
+    INTEGER :: 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,*) "reduce_sum_rgen VarIn",VarIn
+    IF (flag) CALL suspend_timer(timer_mpi)
+   
+    CALL MPI_REDUCE(VarIn,VarOut,nb,MPI_REAL_ORCH,MPI_SUM,root_prc,MPI_COMM_ORCH,ierr)
+        
+    IF (flag) CALL resume_timer(timer_mpi)
+    IF (check) &
+       WRITE(numout,*) "reduce_sum_rgen VarOut",VarOut
+
+  END SUBROUTINE reduce_sum_rgen
+
+  subroutine stopit
+    USE ioipsl
+    call MPI_FINALIZE
+
+    CALL ipslerr (3,'transfert_para : gather', &
+         &          'A gather function was called with a VarIn',&
+         &          ' which size is only one.', &
+         &          '(must be strickly greater than one )')
+  end subroutine stopit
+#endif
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/write_field.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/write_field.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/write_field.f90	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/write_field_p.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/write_field_p.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parallel/write_field_p.f90	(revision 854)
@@ -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: perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/AA_make
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/AA_make	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/AA_make	(revision 854)
@@ -0,0 +1,76 @@
+#-
+#- $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_veg.f90 \
+        constantes_soil.f90 \
+        constantes_co2.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
+#-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)(constantes_co2.o): \
+  $(MODEL_LIB)(constantes_veg.o)
+$(MODEL_LIB)(constantes_veg.o): \
+  $(MODEL_LIB)(constantes_soil.o)
+$(MODEL_LIB)(constantes_soil.o): \
+  $(MODEL_LIB)(constantes.o)
+$(MODEL_LIB)(constantes.o): \
+  $(PARALLEL_LIB) \
+  $(IOIPSL_LIB)
+
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/AA_make.ldef
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/AA_make.ldef	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/AA_make.ldef	(revision 854)
@@ -0,0 +1,18 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a PARAMETER
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+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: perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes.f90	(revision 854)
@@ -0,0 +1,85 @@
+! =================================================================================================================================
+! 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 some public technical constants like
+!!                 pi, Earth radius, etc...
+!!
+!!\n DESCRIPTION : 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 constantes_veg.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 
+!!                 You can also find in this module the flags used to activate the different modules  
+!!                 (sechiba,stomate, DGVM, routing, etc.).\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN		:
+!! $HeadURL: $ 
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes
+
+  USE defprec
+  USE parallel
+!-
+  IMPLICIT NONE
+!-
+  LOGICAL,SAVE :: long_print = .FALSE.                   !! To set for more printing (true/false)
+!-
+  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 :: almaoutput                                  !! Selects the type of output for the model.(true/false)
+                                                         !! Value is read from run.def in intersurf_history
+!-
+  REAL(r_std),SAVE :: one_day                            !! One day in seconds (s)
+  REAL(r_std),SAVE :: one_year                           !! One year in seconds (s)
+  REAL(r_std), PARAMETER :: R_Earth = 6378000.           !! Earth radius ~= Equatorial radius (m)
+!-
+  REAL(r_std),PARAMETER :: pi=3.141592653589793238       !! Pi (unitless)
+!-
+  REAL(r_std),PARAMETER :: tp_00=273.15                  !! 0 degre Celsius in degre Kelvin (K)
+!-
+  REAL(r_std),SAVE :: val_exp = 999999.                  !! Specific value if no restart value (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 :: 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 :: mille = 1000._r_std           !! Numerical constant set to 1000 (unitless) 
+!-
+  TYPE control_type                                      !! Structure controlling the parts of the models (true/false)
+    LOGICAL :: river_routing                             !! activate river routing (true/false)
+    LOGICAL :: hydrol_cwrr                               !! activate 11 layers hydrolgy model (true/false)
+    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
+  END TYPE control_type                                  !! a prescription (true/false)
+!--------------------
+END MODULE constantes
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes_co2.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes_co2.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes_co2.f90	(revision 854)
@@ -0,0 +1,116 @@
+! =================================================================================================================================
+! MODULE 	: constantes_co2
+!
+! 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_co2" module contains constants for the photosynthesis.
+!!
+!!\n DESCRIPTION : This module defines constants relevant for photosynthesis parameters which are PFT dependent.\n
+!!                 Some parameters are considered as default for photosynthesis when STOMATE is not activated
+!!                 (flags OK_CO2 and OK_STOMATE) like vcmax, vjmax and temperatures.\n 
+!!                 There exists two parameters in ORCHIDEE which design the extinction coefficient:
+!!                 ext_coef and ext_coeff. ext_coef is used by SECHIBA and ext_coeff (the same parameter) is used by STOMATE.
+!!                 ext_coeff is initialized by ext_coef (given in this module) in stomate_data.f90 .\n
+!!
+!! RECENT CHANGE(S): None
+!!
+!! 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.
+!! - Monsi, M.,and T.Saeki (1953), Uber den Lichtfaktor in den Pflanzengesellschaften und seine
+!! Bedeutung fur die Stoffproduktion, Jpn J.Bot., 14, 22-52
+!! A new translation into English by Marcus Schortemeyer,(2005), Annals of Botany 95: 549â567, 2005
+!! available at www.aob.oupjournals.org
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+MODULE constantes_co2
+
+  USE constantes_veg
+!-
+  IMPLICIT NONE
+!-
+!! indices for assimilation parameters (unitless)
+!-
+  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)
+
+!-
+!
+! The following tables of parameters for SECHIBA
+! are in the following order :
+!
+!    1 - Bare soil
+!    2 - tropical  broad-leaved evergreen
+!    3 - tropical  broad-leaved raingreen
+!    4 - temperate needleleaf   evergreen
+!    5 - temperate broad-leaved evergreen
+!    6 - temperate broad-leaved summergreen
+!    7 - boreal    needleleaf   evergreen
+!    8 - boreal    broad-leaved summergreen
+!    9 - boreal    needleleaf   summergreen
+!   10 -           C3           grass
+!   11 -           C4           grass
+!   12 -           C3           agriculture
+!   13 -           C4           agriculture
+!
+
+  LOGICAL,DIMENSION(nvm),SAVE :: &                                    !! flag for C4 photosynthesis vegetation types (true/false)
+ &  is_c4 = (/.false.,.false.,.false.,.false.,.false.,.false., &
+ &            .false.,.false.,.false.,.false.,.true.,.false.,.true. /)
+
+  REAL(r_std),DIMENSION(nvm),SAVE :: &                                !! slope of the gs/A relation (Ball & al., 1987) (unitless)
+ &  gsslope = (/0., 9., 9., 9., 9., 9., 9., 9., 9., 9., 3., 9., 3./)
+
+  REAL(r_std),DIMENSION(nvm),SAVE :: &                                !! intercept of the gs/A relation (Ball & al.) (unitless) 
+ &  gsoffset = (/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),DIMENSION(nvm),SAVE :: &                                !! values used for vcmax when STOMATE is not activated 
+                                                                      !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+ &  vcmax_fix = (/  0., 40., 50., 30., 35., 40., &                    
+ &                 30., 40., 35., 60., 60., 70., 70. /)
+
+  REAL(r_std),DIMENSION(nvm),SAVE :: &                                !! values used for vjmax when STOMATE is not activated 
+                                                                      !! @tex ($\mu mol m^{-2} s^{-1}$) @endtex
+ &  vjmax_fix = (/ 0., 80., 100., 60., 70., 80., &                    
+ &                 60., 80., 70., 120., 120., 140., 140. /)
+
+  REAL(r_std),DIMENSION(nvm),SAVE :: &                                !! values of minimum temperature for photosynthesis when 
+                                                                      !! STOMATE is not activated (C) 
+ &  co2_tmin_fix = (/ 0.,  2.,  2., -4., -3., -2., &                  
+ &                   -4., -4., -4., -5.,  6., -5.,  6. /)            
+
+  REAL(r_std),DIMENSION(nvm),SAVE :: &                                !! values of optimal temperature for photosynthesis when 
+                                                                      !! STOMATE is not activated (C)
+ &  co2_topt_fix = (/  0.,  27.5, 27.5, 17.5, 25.,  20.,  &           
+ &                    17.5, 17.5, 17.5, 20.,  32.5, 20.,  32.5 /)     
+
+  REAL(r_std),DIMENSION(nvm),SAVE :: &                                !! values used maximum temperature for photosynthesis when 
+                                                                      !! STOMATE is not activated (C)
+ &  co2_tmax_fix = (/ 0., 55., 55., 38., 48., 38., &                  
+ &                   38., 38., 38., 45., 55., 45., 55. /)             
+
+  REAL(r_std),DIMENSION(nvm),SAVE :: &                                !! extinction coefficient of radiation interception 
+                                                                      !! (Monsi & Saeki,1953) (unitless)
+ &  ext_coef = (/.5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5, .5/) 
+
+  CHARACTER(LEN=100) :: stomate_forcing_name='NONE'                   !! name of STOMATE forcing file (unitless)
+! Compatibility with Nicolas Viovy driver.                                           
+  CHARACTER(LEN=100) :: stomate_Cforcing_name='NONE'                  !! name of soil forcing file (unitless)
+! Compatibility with Nicolas Viovy driver.                                          
+  INTEGER(i_std),SAVE :: forcing_id                                   !! index of the forcing file (unitless)
+!------------------------
+END MODULE constantes_co2
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes_soil.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes_soil.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes_soil.f90	(revision 854)
@@ -0,0 +1,166 @@
+! =================================================================================================================================
+! 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 public data for the soils.
+!!
+!!\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
+
+  USE constantes
+!-
+  IMPLICIT NONE
+!-
+! 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 (unitless)
+!MM : if you want to compare hydrology variables with old TAG 1.6 and lower, 
+!     you must set the Number of diagnostic levels in the soil to 6 :
+!  INTEGER(i_std),PARAMETER :: nbdl=6
+  INTEGER(i_std),PARAMETER :: nslm=11           !! Number of levels in CWRR (unitless)
+  INTEGER(i_std),PARAMETER :: nstm=3            !! Number of soil types (unitless)
+
+!-
+!- Parameters for soil thermodynamics
+!-
+  REAL(r_std),PARAMETER :: so_cond = 1.5396     !! Average Thermal Conductivity of soils  @tex $(W.m^{-2}.K^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: so_capa = 2.0514e+6  !! Average Heat capacity of soils @tex $(J.m^{-3}.K^{-1})$ @endtex
+
+!-
+! Values taken from : PIELKE,'MESOSCALE METEOROLOGICAL MODELING',P.384
+! Dry soil heat capacity was decreased and conductivity increased.
+!-
+!
+!*REAL(r_std),PARAMETER :: so_capa_dry = 1.35e+6
+  REAL(r_std),PARAMETER :: so_capa_dry = 1.80e+6            !! Dry soil Heat capacity of soils @tex $(J.m^{-3}.K^{-1})$ @endtex 
+!*REAL(r_std),PARAMETER :: so_cond_dry = 0.28
+  REAL(r_std),PARAMETER :: so_cond_dry = 0.40               !! Dry soil Thermal Conductivity of soils @tex $(W.m^{-2}.K^{-1})$ @endtex
+!-
+  REAL(r_std),PARAMETER :: so_capa_wet = 3.03e+6            !! Wet soil Heat capacity of soils  @tex $(J.m^{-3}.K^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: so_cond_wet = 1.89               !! Wet soil Thermal Conductivity of soils @tex $(W.m^{-2}.K^{-1})$ @endtex 
+!-
+  REAL(r_std),PARAMETER :: sn_cond = 0.3                    !! Thermal Conductivity of snow @tex $(W.m^{-2}.K^{-1})$ @endtex  
+  REAL(r_std),PARAMETER :: sn_dens = 330.0                  !! Snow density for the soil thermodynamics (unitless)
+  REAL(r_std),PARAMETER :: sn_capa = 2100.0_r_std*sn_dens   !! Heat capacity for snow @tex $(J.m^{-3}.K^{-1})$ @endtex
+
+!-
+! Constantes from the Choisnel hydrology
+!-
+  REAL(r_std),PARAMETER :: qwilt = 5.0              !! Wilting point (Has a numerical role for the moment) (??units??)
+  REAL(r_std),SAVE      :: dpu_cste=2.0_r_std       !! Total depth of soil reservoir (for hydrolc) (m)
+  REAL(r_std),PARAMETER :: min_resdis = 2.e-5       !! The minimal size we allow for the upper reservoir (m)
+  REAL(r_std),PARAMETER :: min_drain = 0.001        !! Diffusion constant for the slow regime @tex $(kg.m^{-2}.dt^{-1})$ @endtex
+                                                    ! (This is for the diffusion between reservoirs)
+
+  REAL(r_std),PARAMETER :: max_drain = 0.1          !! Diffusion constant for the fast regime @tex $(kg.m^{-2}.dt^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: exp_drain = 1.5          !! The exponential in the diffusion law (unitless)
+  REAL(r_std),SAVE      :: qsintcst = 0.1           !! Transforms leaf area index into size of interception reservoir (unitless)
+  REAL(r_std),PARAMETER :: mx_eau_eau = 150.        !! Maximum quantity of water @tex $(kg.m^{-3} of soil)$ @endtex
+!-
+
+  REAL(r_std),PARAMETER :: rsol_cste = 33.E3        !! Constant in the computation of resistance for bare soil evaporation
+                                                    !! @tex $(s.m^{-2})$ @endtex
+  REAL(r_std),PARAMETER :: hcrit_litter=0.08_r_std  !! Scaling depth for litter humidity (m)
+!-
+! Parameters for soil type distribution
+!-
+  REAL(r_std),DIMENSION(nstm),SAVE :: soiltype_default = &    !! Default soil texture distribution in the following order 
+ & (/ 0.0, 1.0, 0.0 /)                                        !! sand, loam and clay (0-1, unitless)
+
+!-
+! Parameters specific for the CWRR hydrology.
+!-
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: nvan = &           !! Van Genuchten coefficient n (unitless)
+ & (/ 1.89_r_std, 1.56_r_std, 1.31_r_std /)
+
+!  REAL(r_std),PARAMETER,DIMENSION(nstm) :: avan = &
+! & (/ 0.036_r_std, 0.036_r_std, 0.036_r_std /)
+!TdO
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: avan = &           !! Van Genuchten coefficient a @tex $(mm^{-1})$ @endtex
+  & (/ 0.0075_r_std, 0.0036_r_std, 0.0019_r_std /) 
+
+  INTEGER(i_std),PARAMETER :: imin = 1                        !! CWRR linearisation (unitless)
+  INTEGER(i_std),PARAMETER :: nbint = 100                     !! Number of interval for CWRR (unitless)
+  INTEGER(i_std),PARAMETER :: imax = nbint+1                  !! Number of points for CWRR (unitless)
+
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: mcr = &            !! Residual soil water content (mm)
+ & (/ 0.065_r_std, 0.078_r_std, 0.095_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: mcs = &            !! Saturated soil water content (unitless)
+ & (/ 0.41_r_std, 0.43_r_std, 0.41_r_std /)
+
+  REAL(r_std),SAVE,DIMENSION(nstm) :: dpu = &                 !! Total depth of soil reservoir (m)
+ & (/ 2.0_r_std, 2.0_r_std, 2.0_r_std /)                      ! dpu must be constant over the different soil types
+
+
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: ks = &             !! Hydraulic conductivity Saturation  @tex $(mm.day^{-1})$ @endtex
+ & (/ 1060.8_r_std, 249.6_r_std, 62.4_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: pcent = &          !! Soil moisture above which transpir is max (0-1, unitless)
+ & (/ 0.5_r_std, 0.5_r_std, 0.5_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: free_drain_max = & !! Max value of the permeability coeff at the bottom of the soil 
+ & (/ 1.0_r_std, 1.0_r_std, 1.0_r_std /)                      !! (??units??)
+
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: mcf = &            !! Volumetric water content field capacity (unitless)
+ & (/ 0.32_r_std, 0.32_r_std, 0.32_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: mcw = &            !! Volumetric water content Wilting pt (unitless)
+ & (/ 0.10_r_std, 0.10_r_std, 0.10_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: mc_awet = &        !! Volumetric water content above which albedo is cst (unitless)
+ & (/ 0.25_r_std, 0.25_r_std, 0.25_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: mc_adry = &        !! Volumetric water content below which albedo is cst (unitless)
+ & (/ 0.1_r_std, 0.1_r_std, 0.1_r_std /)
+
+  REAL(r_std),PARAMETER,DIMENSION(nstm) :: psis = &           !! [DISPENSABLE] Matrix potential at saturation (mm)
+ & (/ -300.0_r_std, -300.0_r_std, -300.0_r_std /)
+
+  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)
+!-------------------------
+END MODULE constantes_soil
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes_veg.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes_veg.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_parameters/constantes_veg.f90	(revision 854)
@@ -0,0 +1,1302 @@
+! =================================================================================================================================
+! MODULE 	: constantes_veg
+!
+! 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_veg" module contains public physical constants
+!! and public tools functions like  qsat, dev_qsat. It also contains the subroutines 
+!! get_vegcorr and get_soilcorr used for the old interpolation maps. 
+!!
+!!\n DESCRIPTION: None 
+!!
+!! REFERENCE(S)	: 
+!! - Chalita, S. (1992), SensibilitÃ© du modÃšle de circulation atmosphÃ©rique 
+!! du LMD Ã   l'albÃ©do des surfaces enneigÃ©es: RÃ©sultats prÃ©liminaires de rÃ©troactions 
+!! liÃ©es Ã  la couverture neigeuse. ThÃšse de Doctorat de l'UniversitÃ© Paris VI.
+!! - Louis, Jean-Francois (1979), A parametric model of vertical eddy fluxes in the atmosphere. 
+!! Boundary Layer Meteorology, 187-202.
+!! - DucoudrÃ©, N., Laval, K. and Perrier, A. (1993). SECHIBA, a new set of parameterization
+!! of the hydrologic exchanges at the land-atmosphere interface within the LMD atmospheric 
+!! General circulation model. Journal of climate, 6, 248-273.
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+
+MODULE constantes_veg
+
+  USE IOIPSL
+  USE constantes_soil
+!-
+  IMPLICIT NONE
+
+
+  LOGICAL,SAVE :: l_qsat_first=.TRUE.                          !! First call to qsat subroutines and functions (true/false)
+!-
+  TYPE(control_type),SAVE :: control                           !! Flags that (de)activate parts of the model (true/false)
+!-
+  INTEGER(i_std),PARAMETER :: nvm=13                           !! Number of vegetation types (unitless)
+  INTEGER(i_std),PARAMETER :: nnobio=1                         !! Number of other surface types: land ice (lakes,cities, ...)
+                                                               !!(unitless)
+!-
+  INTEGER(i_std),PARAMETER :: iice = 1
+  REAL(r_std),PARAMETER :: maxmass_glacier = 3000.             !! The maximum mass of a glacier. @tex $(kg.m^{-2})$ @endtex
+!-
+  REAL(r_std),PARAMETER :: min_vegfrac=0.001                   !! Minimal fraction of mesh a vegetation type can occupy 
+							       !! (0-1, unitless)
+!-
+  REAL(r_std),PARAMETER :: defc_plus=23.E-3                    !! Constant in the computation of surface resistance 
+                                                               !! @tex $ (K.W^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: defc_mult=1.5                       !! Constant in the computation of surface resistance 
+                                                               !! @tex $ (K.W^{-1})$ @endtex
+!-
+  REAL(r_std),PARAMETER :: tsnow=273.                          !! Limit of air temperature for snow @tex $(K)$ @endtex
+!-
+  REAL(r_std),PARAMETER :: snowcri=1.5                         !! Sets the snow mass threshold above which only sublimation 
+							       !! occurs @tex $(kg.m^{-2})$ @endtex
+  REAL(r_std),PARAMETER :: snowcri_alb=10.                     !! Critical value for computation of snow albedo 
+                                                               !! @tex $(kg.m^{-2})$ @endtex
+  REAL(r_std),PARAMETER :: sneige=snowcri/1000._r_std          !! Lower limit of snow amount @tex $(kg.m^{-2})$ @endtex
+  REAL(r_std),PARAMETER :: chalsu0 = 2.8345E06                 !! Latent heat of sublimation @tex $(J.kg^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: chalev0 = 2.5008E06                 !! Latent heat of evaporation @tex $(J.kg^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: chalev1 = 2.5008E06                 !! [DISPENSABLE] Latent heat of evaporation 2 @tex $(J.kg^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: chalfu0 = chalsu0-chalev0           !! Latent heat of fusion @tex $(J.kg^{-1})$ @endtex 
+!-
+  REAL(r_std),PARAMETER :: c_stefan = 5.6697E-8                !! Stefan-Boltzman constant @tex $(W.m^{-2}.K^{-4})$ @endtex
+  REAL(r_std),PARAMETER :: cp_air = 1004.675                   !! Specific heat of dry air @tex $(J.kg^{-1}.K^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: cte_molr = 287.05                   !! Specific constant of dry air @tex $(J.kg^{-1}.K^{-1})$ @endtex
+  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 @tex $(kg.mol^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: msmlr_h2o = 18.02E-03               !! Molecular weight of water vapor @tex $(kg.mol^{-1})$ @endtex 
+  REAL(r_std),PARAMETER :: cp_h2o = &                          !! Specific heat of water vapor @tex $(J.kg^{-1}.K^{-1})$ @endtex
+ & cp_air*(4._r_std*msmlr_air)/( 3.5_r_std*msmlr_h2o)
+  REAL(r_std),PARAMETER :: cte_molr_h2o = cte_molr/4._r_std    !! Specific constant of water vapor @tex $(J.kg^{-1}.K^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: retv = msmlr_air/msmlr_h2o-1._r_std !! Ratio between molecular weight of dry air and water vapor
+							       !! minus 1(unitless)
+  REAL(r_std),PARAMETER :: rvtmp2 = cp_h2o/cp_air-1._r_std     !! 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 @tex $(m^2.s^{-2})$ @endtex
+  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 @tex $(m.s^{-2})$ @endtex
+  REAL(r_std),PARAMETER :: cb = 5._r_std                       !! Constantes of the Louis scheme (unitless); 
+							       !! reference to Louis (1979)
+  REAL(r_std),PARAMETER :: cc = 5._r_std                       !! Constantes of the Louis scheme (unitless); 
+          						       !! reference to Louis (1979)
+  REAL(r_std),PARAMETER :: cd = 5._r_std                       !! Constantes of the Louis scheme (unitless); 
+                                                               !! reference to Louis (1979)
+  REAL(r_std),PARAMETER :: min_wind = 0.1                      !! The minimum wind  @tex $(m.s^{-1})$ @endtex
+  REAL(r_std),PARAMETER :: pa_par_hpa = 100._r_std             !! Transform pascal into hectopascal (unitless)
+  REAL(r_std),PARAMETER :: tcst_snowa = 5._r_std               !! Time constant of the albedo decay of snow (days)
+  REAL(r_std),PARAMETER :: max_snow_age = 50._r_std            !! Maximum period of snow aging (days)
+  REAL(r_std),PARAMETER :: snow_trans = 0.3_r_std              !! Transformation time constant for snow (m)
+  REAL(r_std),PARAMETER :: z0_bare = 0.01                      !! bare soil roughness length (m)
+  REAL(r_std),PARAMETER :: z0_ice = 0.001                      !! ice roughness length (m)
+!-
+  LOGICAL,SAVE :: agriculture = .TRUE.                         !! allow agricultural PFTs (true/false)
+!
+! The following tables of parameters for SECHIBA
+! are in the following order :
+!
+!    1 - Bare soil
+!    2 - tropical  broad-leaved evergreen
+!    3 - tropical  broad-leaved raingreen
+!    4 - temperate needleleaf   evergreen
+!    5 - temperate broad-leaved evergreen
+!    6 - temperate broad-leaved summergreen
+!    7 - boreal    needleleaf   evergreen
+!    8 - boreal    broad-leaved summergreen
+!    9 - boreal    needleleaf   summergreen
+!   10 -           C3           grass
+!   11 -           C4           grass
+!   12 -           C3           agriculture
+!   13 -           C4           agriculture
+!
+  REAL(r_std),DIMENSION(nvm),SAVE :: veget_ori_fixed_test_1 = &  !! Values for vegetation distribution within the mesh (0-dim mode)
+ & (/ 0.2, 0.0, 0.0, 0.0, 0.0, &                                 !! (0-1, unitless)
+ &    0.0, 0.0, 0.0, 0.0, 0.8, &
+ &    0.0, 0.0, 0.0 /)
+
+  REAL(r_std),SAVE :: frac_nobio_fixed_test_1 = 0.0              !! Value for frac_nobio for tests in 0-dim simulations
+                                                                 !! used as long as there is ice only and no lakes 
+                                                                 !!(0-1, unitless)
+
+! REAL(r_std), DIMENSION(nnobio),SAVE :: frac_nobio_fixed_test_1=(/0.0/)
+!-
+  REAL(r_std),DIMENSION(nvm),SAVE :: llaimax = &                 !! laimax for maximum lai used for interpolation of lai map
+ & (/ 0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2./)    !! @tex $(m^2.m^{-2})$ @endtex
+
+  REAL(r_std),DIMENSION(nvm),SAVE :: llaimin = &                 !! laimin for minimum lai used for interpolation of lai map
+ & (/ 0., 8., 0., 4., 4.5, 0., 4., 0., 0., 0., 0., 0., 0./)      !! @tex $(m^2.m^{-2})$ @endtex
+!-
+  REAL(r_std),DIMENSION(nvm),SAVE :: height_presc = &            !! prescribed height of vegetation. (m)
+                                                                 !! Value for height_presc : one for each vegetation type
+ & (/ 0.,30.,30.,20.,20.,20.,15.,15.,15.,.5,.6,1.,1./)          
+
+  REAL(r_std),DIMENSION(nvm),SAVE :: height_presc_test = &       !! prescribed height of vegetation. (m)
+                                                                 !! Value for height_presc : one for each vegetation type
+& (/ 0.,30.,30.,20.,20.,20.,15.,15.,15.,.5,.6,1.,1./)      
+!-
+  REAL(r_std),DIMENSION(nvm),SAVE :: rstruct_const = &           !! Structural resistance. @tex $(s.m^{-1})$ @endtex
+                                                                 !! Value for rstruct_const : one for each vegetation type
+ & (/ 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 /)
+!-
+  REAL(r_std),DIMENSION(nvm),SAVE :: kzero = &                   !! A vegetation dependent constant used in the calculation of
+                                                                 !! the surface resistance. @tex $(kg.m^2.s^{-1})$ @endtex
+                                                                 !! Value for kzero one for each vegetation type
+                                                                 !! reference to DucoudrÃ© et al, 1993 
+ & (/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 /)             
+                                                                 
+!-
+  REAL(r_std),DIMENSION(nvm),SAVE :: wmax_veg = &                !! Maximum field capacity for each of the vegetations (Temporary).
+                                                                 !! Value of wmax_veg : max quantity of water
+                                                                 !! one for each vegetation type @tex $(kg.m^{-3})$ @endtex
+ & (/ 150., 150., 150., 150., 150., 150., 150.,&                 
+ &    150., 150., 150., 150., 150., 150. /)                      
+!-
+  REAL(r_std),DIMENSION(nvm), SAVE :: humcste = &                !! Root profile description for the different vegetation types
+                                                                 !! These are the factors in the exponential function which gets
+                                                                 !! the root density as a function of depth @tex $(m^{-1})$ @endtex
+ & (/5., .8, .8, 1., .8, .8, 1., 1., .8, 4., 4., 4., 4./)       
+                                                                
+!-
+!$  CHARACTER(len=5),DIMENSION(nvm),SAVE :: type_of_lai = &
+!$ & (/ 'mean ', 'mean ', 'inter', 'mean ', 'mean ', &
+!$ &    'inter', 'mean ', 'inter', 'inter', 'inter', &
+!$ &    'inter', 'inter', 'inter' /)
+  CHARACTER(len=5),DIMENSION(nvm),SAVE :: type_of_lai = &        !! Type of behaviour of the LAI evolution algorithm 
+                                                                 !! for each vegetation type. (unitless)
+                                                                 !! Value of type_of_lai, one for each vegetation type 
+                                                                 !! Two possible values: 'mean' or 'interp'
+ & (/ 'inter', 'inter', 'inter', 'inter', 'inter', &            
+ &    'inter', 'inter', 'inter', 'inter', 'inter', &            
+ &    'inter', 'inter', 'inter' /)                              
+! Test by Nathalie : 
+! Even evergreen vegetation is allowed to have a small seasonal cycle.
+
+!-
+  LOGICAL, DIMENSION(nvm),SAVE :: is_tree = &                    !! Is the vegetation type a tree ? (true/false)
+ & (/ .FALSE., .TRUE.,  .TRUE., .TRUE., .TRUE.,  &
+ &    .TRUE.,  .TRUE.,  .TRUE., .TRUE., .FALSE., &
+ &    .FALSE., .FALSE., .FALSE. /)
+!-
+!  REAL(r_std),DIMENSION(nvm),SAVE :: snowa_ini = &
+! & (/ 0.55, 0.,   0.,   0.14, 0.15, &
+! &    0.15, 0.14, 0.15, 0.14, 0.18, &
+! &    0.18, 0.18, 0.18 /)
+  REAL(r_std),DIMENSION(nvm),SAVE :: snowa_ini = &               !! Initial snow albedo value for each vegetation type as
+                                                                 !! it will be used in condveg_snow (unitless)
+ & (/ 0.35, 0.,   0.,   0.14, 0.14, &                            !! Values are from the Thesis of S. Chalita (1992) 
+ &    0.14, 0.14, 0.14, 0.14, 0.18, &                            !! Modified by Nathalie - December 2006 : 
+ &    0.18, 0.18, 0.18 /)                                        !! When there is snow, we limit the bare soil and
+                                                                 !! the vegetation aldebos. The values chosen are close to the 
+                                                                 !! values considered in LMD5.3 with Delphine Texier.
+
+!  REAL(r_std),DIMENSION(nvm),SAVE :: snowa_dec = &
+! & (/ 0.30, 0.,   0.,   0.06, 0.14, &
+! &    0.14, 0.06, 0.25, 0.06, 0.63, &
+! &    0.63, 0.63, 0.63 /)
+!-
+  REAL(r_std),DIMENSION(nvm),SAVE :: snowa_dec = &               !! Decay rate of snow albedo value for each vegetation type
+                                                                 !! as it will be used in condveg_snow (unitless)
+                                                                 !! Values are from the Thesis of S. Chalita (1992)
+ & (/ 0.45, 0.,   0.,   0.06, 0.06, &                            
+ &    0.11, 0.06, 0.11, 0.11, 0.52, &                            
+ &    0.52, 0.52, 0.52 /)                                        !! Modified by Nathalie - December 2006 :
+                                                                 !! When there is snow, we limit the bare soil and
+                                                                 !! the vegetation aldebos. The values chosen are close to the 
+                                                                 !! values considered in LMD5.3 with Delphine Texier.
+
+ 
+  REAL(r_std),DIMENSION(nvm*2),SAVE :: alb_leaf = &              !! leaf albedo of vegetation type, visible (VIS), near infrared (NIR) 
+                                                                 !! (unitless)
+ & (/ .00, .04, .06, .06, .06, &
+ &    .06, .06, .06, .06, .10, &
+ &    .10, .10, .10, &
+ &    .00, .20, .22, .22, .22, &
+ &    .22, .22, .22, .22, .30, &
+ &    .30, .30, .30   /)
+!-
+  INTEGER(i_std),DIMENSION(nvm,nstm) ::  pref_soil_veg           !! Variable which contains the relation between the soil types
+                                                                 !! and vegetation type. Two possible modes :
+                                                                 !!  1) If pref_soil_veg = 0 then we have an equidistribution
+                                                                 !!     of vegetation on soil types
+                                                                 !!  2) Otherwise for each pft the prefered soil type is given :
+                                                                 !!     1=sand, 2=loan, 3=clay (unitless)
+                                                                 !! The variable is initialized in slowproc.
+!-
+  REAL(r_std),DIMENSION(2),SAVE :: alb_deadleaf = (/ .12, .35/)  !! albedo of dead leaves, (VIS),(NIR), (unitless)
+  REAL(r_std),DIMENSION(2),SAVE :: alb_ice = (/ .60, .20/)       !! albedo of ice, (VIS), (NIR), (unitless)
+!-
+  LOGICAL,PARAMETER :: ldveget_ori_on_restart = .TRUE.           !![DISPENSABLE] Is veget_ori array stored in restart file (true/false)
+!-
+  LOGICAL,SAVE :: ldq_cdrag_from_gcm = .FALSE.                   !! Set to .TRUE. if you want q_cdrag to come from GCM (true/false)
+!-
+  REAL(r_std),PARAMETER :: rayt_cste = 125.                      !! Constant used in the computation of surface resistance
+                                                                 !! Solar radiance @tex $(W.m^{-2})$ @endtex
+!-
+
+  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) @tex $(kg.kg^{-1})$ @endtex
+                                                                 
+!-
+
+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{constantes_veg_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)
+    
+    !! 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 degree 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)
+                                                            !! @tex $(kg.kg^{-1})$ @endtex
+
+    !! 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 needed for interpolation (unitless)
+    INTEGER(i_std)                      :: nbad             !! Number of points where the temperature is too high or too low (unitless)
+    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 temperature is over the maximum temperature for saturated humidity (369K)
+    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(2,'qsatcalc','diffuco', '', &
+               &                     'temperature incorrect.') ! 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 temperature is below the minimum temperature for saturated humidity (100K) 
+    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(2,'qsatcalc','diffuco', '', &
+               &                   'temperature incorrect.') ! 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 \n
+    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{constantes_veg_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)
+
+    !! 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 of water/kg of air)
+                                        !! @tex $(kg.kg^{-1})$ @endtex
+      
+    !! 0.4 Local variables
+    
+    INTEGER(i_std)   :: jt              !! Temporary scalar stocking the truncated temperature in Kelvin 
+                                        !! (converted into integer) (unitless)
+    REAL(r_std)      :: zz_a,zz_b,zz_f  !! Temporary scalar variables needed for interpolation (unitless)     
+ 
+!_ ================================================================================================================================
+
+    !-
+    !! 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 temperature over the maximum temperature for saturated humidity (369K) ? 
+    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(2,'qsat','', '',&
+               &                   'temperature incorrect.') ! Warning message
+       ELSE
+          qsat_result = 999999.
+          RETURN
+       ENDIF !(.NOT.diag_qsat)
+       !-
+    ENDIF !(jt >= max_temp-1)
+ 
+    !! 2.2 Is temperature below the minimum temperature for saturated humidity (100K) ?
+    IF (jt <= min_temp ) THEN
+       WRITE(numout,*) &
+            &   ' We stop. temperature too SMALL : ',temp_in, &
+            &   ' approximation for : ',jt
+       !-
+       IF (.NOT.diag_qsat) THEN
+          CALL ipslerr(2,'qsat','', '',&
+               &                   'temperature incorrect.')
+       ELSE
+          qsat_result = -999999.
+          RETURN
+       ENDIF!(.NOT.diag_qsat)
+       !-
+    ENDIF !(jt <= min_temp )
+
+    !! 2.3 Temporary variable 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{constantes_veg_dev_qsatcalc.tex}
+!!               \endlatexonly
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S) : dev_qsat_out
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART	: None
+!!
+!! FLOWCHART    :
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE dev_qsatcalc (kjpindex,temp_in,pres_in,dev_qsat_out)
+
+    !! 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 (Pa)
+
+
+    !! 0.2 Output variables 
+    
+    REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: dev_qsat_out   !! Derivation of the specific humidity (kg of water/kg of air)
+                                                                  !! @tex $(kg.kg^{-1})$ @endtex
+    
+    !! 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 needed for the computation (unitless)
+    INTEGER(i_std)                     :: nbad                    !! Number of points where the temperature is too high or too low 
+                                                                  !! (unitless)
+
+!_ ================================================================================================================================
+
+    !-
+    !! 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 temperature is over the maximum temperature for saturated humidity (369K) 
+    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(3,'dev_qsatcalc','', '', &
+               &                   'temperature incorrect.') ! Fatal error 
+       ELSE
+          WHERE (jt(:) >= max_temp-1)   jt(:) = max_temp-1
+       ENDIF !(.NOT.diag_qsat)
+       !-
+    ENDIF !(nbad > 0)
+
+    !! 2.2 Pixels where temperature is below the minimum temperature for saturated humidity (100K) 
+    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(3,'dev_qsatcalc', '', '',&
+               &                   'temperature incorrect.') ! 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{constantes_veg_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)
+
+    !! 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          !! Temperature (K)
+      
+    !! 0.2 Result
+
+    REAL(r_std) :: dev_qsat_result              !! Derivative of saturated humidity (kg of water/kg of air)
+                                                !! @tex $(kg.kg^{-1})$ @endtex 
+
+    !! 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 temperature over the maximum temperature for saturated humidity (369K) ?
+    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(3,'dev_qsat','', '',&
+               &                   'temperature incorrect.') ! Fatal error 
+       ELSE
+          dev_qsat_result = 999999.
+          RETURN
+       ENDIF !(.NOT.diag_qsat)
+       !-
+    ENDIF !(jt >= max_temp-1)
+
+    !! 2.2 Is temperature below the minimum temperature for saturated humidity (100K) ?
+    IF (jt <= min_temp ) THEN
+       WRITE(numout,*) &
+            &   ' We stop. temperature too LOW : ',temp_in, &
+            &   ' approximation for : ',jt
+       !-
+       IF (.NOT.diag_qsat) THEN
+          CALL ipslerr(3,'dev_qsat','', '',&
+               &                    'temperature incorrect.')
+       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{constantes_veg_goff_gratch.tex}
+!!               \endlatexonly
+!!               qsfrict is initialized by the following formulas : \n
+!!               \latexonly
+!!               \input{constantes_veg_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), \n
+!! 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
+
+    !! 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 needed for the computation (unitless)     
+
+!_ ================================================================================================================================
+
+    !! 1. Initialisation
+    zrapp = msmlr_h2o/msmlr_air
+    zcorr = 0.00320991_r_std
+
+    !! 2. Computes saturated humidity one time and *stores 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
+
+!! ================================================================================================================================
+!! 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 @tex $(K)$ @endtex
+    REAL(r_std),PARAMETER    :: ztempmax=293._r_std   !! Temperature for laimax @tex $(K)$ @endtex
+    REAL(r_std)              :: zfacteur              !! Interpolation factor   @tex $(K^{-2})$ @endtex
+
+    !! 0.1 Input variables
+
+    REAL(r_std),INTENT(in)   :: temp_in               !! Temperature @tex $(K)$ @endtex
+
+    !! 0.2 Output variables 
+
+    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 	: 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)
+
+    !! 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(3,'get_vegcorr', '', '',&
+            &                 'wrong number of OLSON vegetation types.') ! Fatal error
+    ENDIF !(nolson /= nolson94)
+
+    IF (nvm /= nvm13) THEN
+       WRITE(numout,*) nvm,nvm13
+       CALL ipslerr(3,'get_vegcorr', '', '',&
+            &                 'wrong number of SECHIBA vegetation types.') ! Fatal error
+    ENDIF !(nvm /= nvm13)
+
+    !-
+    !! 1 set the indices of non-biospheric surface types to 0.
+    !-
+    nobiocorr(:,:) = 0.
+
+    !-
+    !! 2 Here we construct the correspondance table
+    !!   between Olson and the following ORCHIDEE PFTs.
+    !!   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.6, 0.0, 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 ! Loop over the # Olson types  
+       !-
+       IF ( ABS(SUM(vegcorr(ib,:))+SUM(nobiocorr(ib,:))-1.0) & ! the fraction of the vegetation + 
+            &       > EPSILON(1.0)) THEN                       ! the fraction of nobio should not exceed 1
+          WRITE(numout,*) 'Wrong correspondance for Olson type :', ib
+          CALL ipslerr(3,'get_vegcorr', '', '',&
+               &                 'Wrong correspondance for Olson type.') ! Fatal error
+       ENDIF
+       !-
+    ENDDO ! Loop over the # Olson types  
+
+
+  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)
+
+    !! 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(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(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
+
+
+END MODULE constantes_veg
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/AA_make
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/AA_make	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/AA_make	(revision 854)
@@ -0,0 +1,171 @@
+#-
+#- $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 =              \
+  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
+#-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)(constantes_co2.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_veg.o) \
+  $(PARALLEL_LIB)(parallel.o)
+
+$(MODEL_LIB)(sechiba_io.o): \
+  $(MODEL_LIB)(sechiba_io_p.o) \
+  $(PARAM_LIB)(constantes_veg.o)
+
+$(MODEL_LIB)(watchout.o): \
+  $(ORGLOB_LIB)(grid.o)
+
+$(MODEL_LIB)(hydrol.o):           \
+  $(PARAM_LIB)(constantes_veg.o)  \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(ORGLOB_LIB)(grid.o)
+
+$(MODEL_LIB)(hydrolc.o):          \
+  $(PARAM_LIB)(constantes_veg.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(slowproc.o):         \
+  $(PARAM_LIB)(constantes_co2.o)  \
+  $(STOMATE_LIB)(stomate.o)       \
+  $(MODEL_LIB)(sechiba_io.o)      \
+  $(ORGLOB_LIB)(interpol_help.o)
+
+$(MODEL_LIB)(diffuco.o):          \
+  $(PARAM_LIB)(constantes_co2.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(enerbil.o):          \
+  $(PARAM_LIB)(constantes_veg.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(condveg.o):          \
+  $(PARAM_LIB)(constantes_veg.o)  \
+  $(ORGLOB_LIB)(interpol_help.o)
+
+$(MODEL_LIB)(thermosoil.o): \
+  $(PARAM_LIB)(constantes_soil.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(routing.o):          \
+  $(PARAM_LIB)(constantes_veg.o)  \
+  $(MODEL_LIB)(sechiba_io.o)
+
+$(MODEL_LIB)(intersurf.o): \
+  $(PARAM_LIB)(constantes_veg.o)  \
+  $(ORGLOB_LIB)(grid.o)           \
+  $(MODEL_LIB)(watchout.o)        \
+  $(MODEL_LIB)(sechiba.o)
+
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/AA_make.ldef
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/AA_make.ldef	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/AA_make.ldef	(revision 854)
@@ -0,0 +1,18 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a SECHIBA
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+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: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/condveg.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/condveg.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/condveg.f90	(revision 854)
@@ -0,0 +1,1709 @@
+! ===============================================================================================================================
+! 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 constantes_veg
+  USE interpol_help
+  USE parallel
+
+  IMPLICIT NONE
+
+  ! public routines :
+  ! condveg_main only
+  PRIVATE
+  PUBLIC :: condveg_main,condveg_clear 
+ 
+  !! Initialisation and declaration of general variables of the conveg module
+  
+  LOGICAL, SAVE                                 :: l_first_condveg=.TRUE.     !! To keep first call's trace    
+  LOGICAL, SAVE                                 :: z0cdrag_ave=.FALSE.        !! Chooses between two methods to calculate the 
+                                                                              !! grid average of the roughness (see header of subroutine)           
+  REAL(r_std), SAVE                             :: fixed_snow_albedo          !! To choose a fixed snow albedo value(unitless)     
+  INTEGER(i_std), PARAMETER                     :: ivis = 1                   !! Index for albedo in visible range                        
+  INTEGER(i_std), PARAMETER                     :: inir = 2                   !! Index for albedo in near-infrared range  
+  LOGICAL, SAVE                                 :: impaze                     !! Switch for choosing surface parameters 
+                                                                              !! (see header of subroutine).                          
+  REAL(r_std), SAVE                             :: z0_scal                    !! Surface roughness height imposed(m)    
+  REAL(r_std), SAVE                             :: roughheight_scal           !! Effective roughness Height depending on zero-plane displacement height (m) 
+                                                                              !! (imposed)                   
+  REAL(r_std), SAVE                             :: albedo_scal(2)             !! Albedo values for visible and near-infrared 
+                                                                              !! used imposed (unitless)                  
+  REAL(r_std), SAVE                             :: emis_scal                  !! Surface emissivity imposed(unitless)                       
+  REAL(r_std), ALLOCATABLE, SAVE                :: soilalb_dry(:,:)           !! Albedo values for the dry bare soil (unitless) 
+  REAL(r_std), ALLOCATABLE, SAVE                :: soilalb_wet(:,:)           !! Albedo values for the wet bare soil (unitless)               
+  REAL(r_std), ALLOCATABLE, SAVE                :: soilalb_moy(:,:)           !! Albedo values for the mean bare soil (unitless)                
+  REAL(r_std), PARAMETER                        :: z0_over_height = un/16.    !! Factor to calculate roughness height from 
+                                                                              !! vegetation height (unitless)           
+  REAL(r_std), PARAMETER                        :: height_displacement = 0.75 !! Factor to calculate the zero-plane displacement 
+                                                                              !! height from vegetation height (m)
+  REAL(r_std), ALLOCATABLE, SAVE                :: alb_bare(:,:)              !! Mean bare soil albedo for visible and near-infrared 
+                                                                              !! range (unitless)                  
+  REAL(r_std), ALLOCATABLE, SAVE                :: alb_veget(:,:)             !! Mean vegetation albedo for visible and 
+                                                                              !! near-infrared range (unitless)                          
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: albedo_snow                !! Mean snow albedo over visible and near-infrared 
+                                                                              !! range (unitless)      
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: albedo_glob                !! Mean surface albedo over visible and 
+                                                                              !! near-infrared range (unitless)      
+  LOGICAL, SAVE                                 :: alb_bare_model             !! Switch for choosing values of bare soil albedo (see header of subroutine) 
+
+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, deadleaf_cover, emis, albedo, z0, roughheight, soiltype, 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 - Number of land pixels  (unitless)        
+    INTEGER(i_std),INTENT (in)                          :: rest_id         !! Restart file indentifier (unitless)         
+    INTEGER(i_std),INTENT (in)                          :: hist_id         !! First history file identifier  (unitless)          
+    INTEGER(i_std), OPTIONAL, INTENT (in)               :: hist2_id        !! Second history file identifier (unitless)   
+    REAL(r_std), INTENT (in)                            :: dtradia         !! Time step (s)             
+    LOGICAL, INTENT(in)                                 :: ldrestart_read  !! For restart file to read (unitless)  
+    LOGICAL, INTENT(in)                                 :: ldrestart_write !! For restart file to write (unitless)
+    INTEGER(i_std),DIMENSION (kjpindex), INTENT (in)    :: index           !! Index for the points on the map (unitless)            
+    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         
+    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), INTENT(in)        :: snow            !! Snow mass of vegetative PFTs (kg m^{-2})            
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: snow_age        !! Snow age of vegetative PFTs (days)       
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: snow_nobio      !! Snow mass of non-vegetative surfaces (kg m^{-2})      
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: snow_nobio_age  !! Snow age of non-vegetative surfaces (days)  
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: drysoil_frac    !! Fraction of dry soil (unitless)
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in)    :: height          !! Vegetation height (m) per PFT        
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: deadleaf_cover  !! [DISPENSABLE] fraction of soil covered by dead leaves    
+
+    !! 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              !! Soil Roughness height (m)   
+    REAL(r_std),DIMENSION (kjpindex), INTENT (out)      :: roughheight     !! Grid effective roughness height (m)  
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)  :: soiltype        !! Fraction of soil types (unitless)       
+
+    !! 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, deadleaf_cover, emis, albedo, z0, roughheight)
+
+        ! Call subroutine 'condveg snow'
+        ! In the case of dynamic vegetation, the variable 'veget' is used,
+        ! without dynamic vegetation, the variable 'veget_max' is used
+        IF (control%ok_dgvm) THEN
+           CALL condveg_snow (ldrestart_read, kjpindex, veget, frac_nobio, totfrac_nobio, &
+                snow, snow_age, snow_nobio, snow_nobio_age, albedo, albedo_snow, albedo_glob)
+        ELSE
+           CALL condveg_snow (ldrestart_read, kjpindex, veget_max, frac_nobio, totfrac_nobio, &
+                snow, snow_age, snow_nobio, snow_nobio_age, albedo, albedo_snow, albedo_glob)
+        ENDIF
+
+        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, deadleaf_cover, emis, albedo, z0, roughheight)
+
+    ! Update snow parameters by calling subroutine 'condveg_snow'
+    ! In the case of dynamic vegetation is used, the variable 'veget' is used,
+    ! without dynamic vegetation, the variable 'veget_max' is used
+    IF (control%ok_dgvm) THEN
+       CALL condveg_snow (ldrestart_read, kjpindex, veget, frac_nobio, totfrac_nobio, &
+            snow, snow_age, snow_nobio, snow_nobio_age, albedo, albedo_snow, albedo_glob)
+    ELSE 
+       CALL condveg_snow (ldrestart_read, kjpindex, veget_max, frac_nobio, totfrac_nobio, &
+            snow, snow_age, snow_nobio, snow_nobio_age, albedo, albedo_snow, albedo_glob)
+    ENDIF
+
+    !! 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(hist_id, 'Albedo', kjit, albedo_glob, kjpindex, index)
+       CALL histwrite(hist_id, 'SAlbedo', kjit, albedo_snow, kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite(hist2_id, 'Albedo', kjit, albedo_glob, kjpindex, index)
+          CALL histwrite(hist2_id, 'SAlbedo', kjit, albedo_snow, kjpindex, index)
+       ENDIF
+    ELSE
+       CALL histwrite(hist_id, 'soilalb_vis', kjit, alb_bare(:,1), kjpindex, index)
+       CALL histwrite(hist_id, 'soilalb_nir', kjit, alb_bare(:,2), kjpindex, index)
+       CALL histwrite(hist_id, 'vegalb_vis',  kjit, alb_veget(:,1), kjpindex, index)
+       CALL histwrite(hist_id, 'vegalb_nir',  kjit, alb_veget(:,2), kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite(hist2_id, 'soilalb_vis', kjit, alb_bare(:,1), kjpindex, index)
+          CALL histwrite(hist2_id, 'soilalb_nir', kjit, alb_bare(:,2), kjpindex, index)
+          CALL histwrite(hist2_id, 'vegalb_vis',  kjit, alb_veget(:,1), kjpindex, index)
+          CALL histwrite(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 
+       
+       ! This option allows the user to impose a snow albedo value.
+       
+       ! Get the fixed snow albedo if needed
+       !Config Key  = CONDVEG_SNOWA
+       !Config Desc = The snow albedo used by SECHIBA
+       !Config Def  = DEF 
+       !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 (1994).
+       fixed_snow_albedo = undef_sechiba
+       CALL getin_p('CONDVEG_SNOWA', fixed_snow_albedo)
+       
+       ! Choice the way of calculation 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.
+       
+       !Config Key  = ALB_BARE_MODEL
+       !Config Desc = Switch bare soil albedo dependent (if TRUE) on soil wetness
+       !Config Def  = FALSE
+       !Config Help = If TRUE, the model for bare soil albedo is the old formulation.
+       !Config        Then it depend on the soil moisture. If FALSE, it is the 
+       !Config        new computation that is taken, it is the mean of soil albedo.
+       alb_bare_model=.FALSE.
+       CALL getin_p('ALB_BARE_MODEL', alb_bare_model)
+              
+       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('UNITS', '-')
+       CALL ioconf_setatt('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('UNITS', '-')
+       CALL ioconf_setatt('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('UNITS', '-')
+       CALL ioconf_setatt('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, deadleaf_cover, 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)          
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: deadleaf_cover  !! [DISPENSABLE] fraction of soil covered by dead 
+                                                                           !! leaves    
+
+    !! 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.
+    
+    !Config Key  = IMPOSE_AZE
+    !Config Desc = Should the surface parameters be prescribed
+    !Config Def  = n
+    !Config Help = This flag allows the user to impose the surface parameters
+    !Config        (Albedo, surface roughness and Emissivity). It is especially interesting for 0D
+    !Config        simulations. On the globe it does not make too much sense as
+    !Config        it imposes the same parameters everywhere
+    impaze = .FALSE.
+    CALL getin_p('IMPOSE_AZE', impaze)
+
+    !! 2. Calculate emissivity
+
+    ! If TRUE read in default values for emissivity
+
+     IF ( impaze ) THEN
+       
+       !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 longwave emission
+       !Config        of the surface in a 0-dim version. Values range between 
+       !Config        0.94 for flat bare soils and 1. for fully vegetated grid. The GCM uses an average value of 0.98.
+       emis_scal = un
+       CALL getin_p('CONDVEG_EMIS', emis_scal)
+       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
+        
+        !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.
+        albedo_scal(ivis) = 0.25_r_std
+        CALL getin_p('CONDVEG_ALBVIS', albedo_scal(ivis))
+        albedo(:,ivis) = 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.   
+        albedo_scal(inir) = 0.25_r_std
+        CALL getin_p('CONDVEG_ALBNIR', albedo_scal(inir))
+        albedo(:,inir) = albedo_scal(inir)
+
+    ! If FALSE calculate albedo
+    ELSE
+       
+       CALL condveg_albcalc (kjpindex,deadleaf_cover,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.
+    
+    !Config Key  = Z0CDRAG_AVE
+    !Config Desc = Average method for z0
+    !Config Def  = y
+    !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
+    z0cdrag_ave = .TRUE.
+    CALL getin_p('Z0CDRAG_AVE', z0cdrag_ave)
+
+    !  TRUE read in default values for roughness height
+    IF ( impaze ) THEN
+      
+      !Config Key  = CONDVEG_Z0
+      !Config Desc = Surface roughness (m)
+      !Config Def  = 0.15
+      !Config If   = IMPOSE_AZE
+      !Config Help = Surface roughness 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.
+      z0_scal = 0.15_r_std
+      CALL getin_p('CONDVEG_Z0', z0_scal)
+      z0(:) = z0_scal
+      !
+      !Config Key  = ROUGHHEIGHT
+      !Config Desc = Height to be added to the height of the first level (m)
+      !Config Def  = 0.0
+      !Config If   = IMPOSE_AZE
+      !Config Help = ORCHIDEE calculates the surface fluxes between the atmospheric level height and
+      !Config        the zero wind level. The zero wind level of vegetation is estimated from the
+      !Config        displacement height which depends on
+      !Config        the vegetation height. It is called the roughness height in
+      !Config        ORCHIDEE talk.
+      !
+      roughheight_scal = zero
+      CALL getin_p('ROUGHHEIGHT', roughheight_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, deadleaf_cover, 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)         
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)        :: deadleaf_cover   !! [DISPENSABLE] fraction of soil covered by dead 
+                                                                            !! leaves
+    !! 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,deadleaf_cover,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, 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,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 ! Loop over # nobio types
+
+      !! 2.1 Calculate snow albedo 
+
+      ! For  vegetated surfaces
+      fraction_veg(:) = un - totfrac_nobio(:)
+      snowa_veg(:) = zero
+      DO jv = 1, nvm ! Loop over # PFTs
+        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 ! Loop over # PFTs
+
+      ! For non-vegtative surfaces
+      DO jv = 1, nnobio ! Loop over # nobio surfaces
+        DO ji = 1, kjpindex
+          snowa_nobio(ji,jv) = ( snowa_ini(1) + snowa_dec(1) * agefunc_nobio(ji,jv) ) 
+        ENDDO
+      ENDDO ! Loop over # nobio surfaces
+    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 ! Loop over # spectra
+      
+      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 ! Loop over # nobio surfaces
+      
+    END DO ! Loop over # spectra
+
+    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
+    INTEGER(i_std), PARAMETER                     :: classnb = 9           !! Levels of soil colour classification
+    REAL(r_std), 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
+    REAL(r_std), 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 
+    REAL(r_std), 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 
+    REAL(r_std), 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
+    REAL(r_std), 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
+    REAL(r_std), 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
+    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 colours
+  !Config Def  = ../surfmap/soils_param.nc
+  !Config If   = !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.
+  filename = '../surfmap/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
+     PRINT *,"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
+     PRINT *,"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
+     PRINT *,"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
+     PRINT *,"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
+  
+  !! 2. Interpolation
+
+  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
+        PRINT *,"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
+        PRINT *,"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 ! Loop over domain size
+        
+        ! 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(:) = veget(:,1) * LOG(z0_bare)
+
+    ! Define fraction of bare soil
+    sumveg(:) = veget(:,1)
+
+    ! 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(:) = veget(:,1) * (ct_karman/LOG(ztmp(:)/z0_bare))**2
+
+    ! Fraction of bare soil
+    sumveg(:) = veget(:,1)
+
+    ! 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 !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
+
+          ! 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,deadleaf_cover,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), INTENT(in)     :: deadleaf_cover !! [DISPENSABLE] Fraction of soil covered by dead 
+                                                                       !! leaves (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(:,1) = alb_leaf(1:nvm)
+    alb_leaf_tmp(:,2) = alb_leaf(nvm+1:2*nvm)
+ 
+ !! 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) = veget(:,1) * 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 ! Loop over number of spectra
+    
+  END SUBROUTINE condveg_albcalc
+
+END MODULE condveg
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/diffuco.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/diffuco.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/diffuco.f90	(revision 854)
@@ -0,0 +1,2760 @@
+! ================================================================================================================================
+!  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 constantes_veg
+  USE sechiba_io
+  USE ioipsl
+  USE constantes_co2
+  USE parallel
+!  USE WRITE_FIELD_p
+
+  IMPLICIT NONE
+
+  ! public routines :
+  ! diffuco_main only
+  PRIVATE
+  PUBLIC :: diffuco_main,diffuco_clear
+
+  !
+  ! variables used inside diffuco module : declaration and initialisation
+  !
+
+  ! variables common to diffuco module 
+  INTEGER(i_std), PARAMETER                          :: nlai = 20
+  LOGICAL, SAVE                                      :: l_first_diffuco = .TRUE.  !! Initialisation has to be done one time
+  CHARACTER(LEN=80)                                  :: var_name                  !! To store variables names for I/O (-)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: leaf_ci                   !! intercellular CO2 concentration (ppm)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: rstruct                   !! architectural resistance (s m^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: raero                     !! Aerodynamic resistance (s m^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: qsatt                     !! Surface saturated humidity (kg kg^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: wind                      !! Wind module (m s^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: rveg_pft                  !! Nathalie le 28 mars 2006 - sur proposition de Fred Hourdin, ajout
+                                                                                  !! d'un potentiometre pour regler la resistance de la vegetation
+
+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, 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, snow, frac_nobio, snow_nobio, totfrac_nobio, &
+     & swnet, swdown, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, &
+     & vbeta , valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, rveget, cimean, 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*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)      :: 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,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)      :: 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 ??)
+    !! 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,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) :: rveget           !! Stomatal resistance for the whole canopy (s m^{-1})
+    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
+!_ ================================================================================================================================
+    
+  !! 1. Perform initialisation, if required
+    
+    IF (l_first_diffuco) THEN
+
+        !Config Key  = CDRAG_FROM_GCM
+        !Config Desc = Keep cdrag coefficient from gcm.
+        !Config Def  = TRUE if q_cdrag on initialization is non zero
+        !Config Help = Set to .TRUE. if you want q_cdrag coming from GCM.
+        !Congig        Keep cdrag coefficient from gcm for latent and sensible heat fluxes.
+        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)
+
+        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, veget_max, 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)
+
+  !! 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) 
+
+  !! 7. Calculate the beta coefficient for bare soil
+
+    CALL diffuco_bare (kjpindex, dtradia, u, v, q_cdrag, rsol, evap_bare_lim, evapot, humrel, veget, vbeta4) 
+
+  !! 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, 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, rveget, rstruct, cimean, vbetaco2, vbeta23)
+
+    ENDIF
+
+  !! 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)    
+
+    IF ( .NOT. almaoutput ) THEN
+       CALL histwrite(hist_id, 'rstruct', kjit, rstruct, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'raero', kjit, raero, kjpindex, index)
+       ! Ajouts Nathalie - novembre 2006
+       CALL histwrite(hist_id, 'cdrag', kjit, q_cdrag, kjpindex, index)
+       CALL histwrite(hist_id, 'Wind', kjit, wind, kjpindex, index)
+       ! Fin ajouts Nathalie
+       CALL histwrite(hist_id, 'qsatt', kjit, qsatt, kjpindex, index)
+
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite(hist2_id, 'rstruct', kjit, rstruct, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'raero', kjit, raero, kjpindex, index)
+          CALL histwrite(hist2_id, 'cdrag', kjit, q_cdrag, kjpindex, index)
+          CALL histwrite(hist2_id, 'Wind', kjit, wind, kjpindex, index)
+          CALL histwrite(hist2_id, 'qsatt', kjit, qsatt, kjpindex, index)
+       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)
+
+  !! 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 (inout)  :: q_cdrag            !! Product of Surface drag and wind speed (m s^{-1})
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                    :: ier, jv
+    INTEGER(i_std)                                    :: ilai
+    CHARACTER(LEN=4)                                  :: laistring
+    REAL(r_std),DIMENSION (kjpindex)                  :: temp
+!_ ================================================================================================================================
+    
+  !! 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 (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 'diffuco_init'
+    END IF
+    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('UNITS', 's/m')
+        CALL ioconf_setatt('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('UNITS', 's/m')
+        CALL ioconf_setatt('LONG_NAME','Aerodynamic resistance')
+        IF ( ok_var(var_name) ) THEN
+           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
+        ENDIF
+        
+        var_name='qsatt' ;
+        CALL ioconf_setatt('UNITS', 'g/g')
+        CALL ioconf_setatt('LONG_NAME','Surface saturated humidity')
+        IF ( ok_var(var_name) ) THEN
+           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
+        ENDIF
+
+        ! the following variable is read only if CO2 is calculated
+        IF ( control%ok_co2 ) THEN
+
+           CALL ioconf_setatt('UNITS', 'ppm')
+           CALL ioconf_setatt('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 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.
+           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('LONG_NAME','Drag coefficient for LE and SH')
+           CALL ioconf_setatt('UNITS', '-')
+           IF ( ok_var(var_name) ) THEN
+              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
+        
+    ENDIF
+
+    !
+    ! Ajouts Nathalie - le 28 Mars 2006 - sur conseils Fred Hourdin
+    !
+    ALLOCATE (rveg_pft(nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) &
+            ' error in rveg_pft allocation. We stop. We need nvm words = ', nvm
+       STOP 'diffuco_init'
+    END IF
+    !
+    !Config Key  = RVEG_PFT
+    !Config Desc = Artificial parameter to increase or decrease canopy resistance.
+    !Config Def  = 1.
+    !Config Help = This parameter is set by PFT.
+    rveg_pft(:) = un
+    CALL getin_p('RVEG_PFT', rveg_pft)
+
+    WRITE(numout,*) 'DANS DIFFUCO_INIT , RVEG_PFT=',rveg_pft
+
+    IF (long_print) WRITE (numout,*) ' diffuco_init done '
+
+  END SUBROUTINE diffuco_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 (rstruct)) DEALLOCATE (rstruct)
+      IF (ALLOCATED (raero)) DEALLOCATE (raero)
+      IF (ALLOCATED (rveg_pft)) DEALLOCATE (rveg_pft)
+
+  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, veget_max, 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,nvm), INTENT (in)   :: veget_max        !! Fraction of vegetation type (-)
+    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_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)
+   
+  ! Nathalie - Juin 2006 - Introduction de vbeta23
+  ! SUBROUTINE diffuco_inter (kjpindex, dtradia, qair, qsatt, rau, u, v, q_cdrag, veget, &
+  !   & qsintveg, qsintmax, rstruct, vbeta2)
+
+  !! 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 = 1,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
+
+      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, 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 (-)
+    
+    !! 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
+
+    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
+              
+          ! Calculation of the soil resistance and the beta ($\beta_4$) for bare soil.
+          ! note: veget (  ,1) contains the fraction of bare soil
+          !   see hydrol module
+          IF (veget(ji,1) .GE. min_sechiba) THEN
+            
+             !! \latexonly 
+             !!     \input{diffucobare1.tex}
+             !! \endlatexonly
+             speed = MAX(min_wind, wind(ji))
+             
+             ! Correction Nathalie de Noblet - le 27 Mars 2006
+             ! Selon recommandation de Frederic Hourdin: supprimer humrel dans formulation vbeta4
+             ! vbeta4(ji) = veget(ji,1) *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)!!
+             
+             !! The calculation of $\beta_4$
+             !! \latexonly 
+             !!     \input{diffucobare2.tex}
+             !! \endlatexonly
+             vbeta4(ji) = veget(ji,1) * (un / (un + speed * q_cdrag(ji) * rsol(ji)))
+             
+          ENDIF
+          
+       END DO
+    ELSE
+       DO ji = 1, kjpindex
+          
+          !! \latexonly 
+          !!     \input{diffucobare3.tex}
+          !! \endlatexonly
+          vbeta4(ji) = evap_bare_lim(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, rveget, rstruct, cimean, vbetaco2, vbeta23)
+
+  ! Nathalie - Juin 2006 - introduction de vbeta23
+  ! SUBROUTINE 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)  
+  
+
+  !! 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) :: 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
+!_ ================================================================================================================================
+
+
+  !! 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.
+
+    DO jv = 1,nvm
+
+      rveget(:,jv) = undef_sechiba
+      vbeta3(:,jv) = zero
+
+      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))
+            
+            ! 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
+
+         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, 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
+! N. de Noblet - 2006/06 
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: vbeta23          !! Beta for fraction of wetted foliage that will 
+                                                                                 !! transpire (unitless) 
+! N. de Noblet - 2006/06 
+
+    !
+    !! 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)       :: 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 (??)
+
+! PARAMETER VALUES
+    REAL(r_std), PARAMETER                :: laimax = 12.                        !! maximum LAI @tex ($m^2 m^{-2}$) @endtex
+    REAL(r_std), PARAMETER                :: xc4_1 = .83
+    REAL(r_std), PARAMETER                :: xc4_2 = .93
+
+! @defgroup Photosynthesis Photosynthesis
+! @{   
+    ! 1. Preliminary calculations\n
+    !
+    ! 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(.15*REAL(jl-1,r_std))-1.)/(EXP(.15*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_coef(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(:) / (0.622+q2m(:)*0.378) ) / &
+      ( qsatt(:)*pb(:) / (0.622+qsatt(:)*0.378 ) )
+! @endcodeinc
+! N. de Noblet - 2006/06 
+    !
+    ! @addtogroup Photosynthesis
+    ! @{   
+    ! 2. Loop over vegetation types\n
+    ! @} 
+    !
+    DO jv = 1,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)
+      rveget(:,jv) = undef_sechiba
+      !
+      vbeta3(:,jv) = zero
+      vbetaco2(:,jv) = zero
+      !
+      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. 1.E-8 ) ) THEN
+          IF ( ( veget(ji,jv) .GT. 1.E-8 ) .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)) * .667_r_std
+         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 = 0.177 * EXP( 0.069*(temp_air(index_assi(inia))-tp_00) )  
+            ! = 2.0**(((temp_air(index_assi(inia))-tp_00)-25.0)/10.0)
+            !
+            kt(index_assi(inia)) = 0.7 * x_1 * 1.e6
+            rt(index_assi(inia)) = 0.8 * x_1 / &
+              ( un + EXP(1.3*(temp_air(index_assi(inia))-tmax(index_assi(inia),jv))) )
+            !
+            vc(index_assi(inia)) = vcmax(index_assi(inia),jv) & 
+                * 0.39 * x_1 * water_lim(index_assi(inia)) / &
+!                 * 0.39 * x_1  / &
+                ( (1.0+EXP(0.3*(tmin(index_assi(inia),jv)-temp_air(index_assi(inia))))) &
+                * (1.0+EXP(0.3*(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)) = 39.09 * EXP(.085*(temp_air(index_assi(inia))-tp_00))
+            !
+            Ko(index_assi(inia)) = 2.412 * 210000. &
+                * EXP(.085*(temp_air(index_assi(inia))-tmin(index_assi(inia),jv))) / &
+                  (temp_air(index_assi(inia))-tmin(index_assi(inia),jv))
+            !
+            CP(index_assi(inia)) = 42. * EXP( 9.46*(temp_air(index_assi(inia))-tp_00-25.)/&
+                                                           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
+              x_1 = - ( vc2(index_calc(inic)) + 0.092 * 2.3* swdown(index_calc(inic)) * &
+                    ext_coef(jv) * light(jv,jl) )
+              x_2 = vc2(index_calc(inic)) * 0.092 * 2.3 * swdown(index_calc(inic)) * &
+                    ext_coef(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 + 210000._r_std / Ko(index_calc(inic)) ) )
+
+              ! The value 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 = .8855_r_std*swdown(index_calc(inic))*ext_coef(jv)*light(jv,jl)
+
+              x_3 = x_2+vj2(index_calc(inic))
+              x_4 = ( x_3 - sqrt( x_3*x_3 - (4._r_std*.7_r_std*x_2*vj2(index_calc(inic))) ) ) / &
+                    (2._r_std*.7_r_std)
+              x_5 = x_4 * leaf_ci(index_calc(inic),jv,jl) / &
+                    ( 4.5_r_std *  leaf_ci(index_calc(inic),jv,jl) + &
+                    10.5_r_std*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) ) - .011_r_std * 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) - 1.6_r_std * 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) = .0244*(temp_air(iainia)/tp_00)*&
+             (1013./pb(iainia))*gstot(iainia)
+          gstop(iainia) = .0244 * (temp_air(iainia)/tp_00)*&
+             (1013./pb(iainia))*leaf_gs_top(iainia)*&
+              laitab(ilai(iainia)+1)
+          !
+          rveget(iainia,jv) = un/gstop(iainia)
+          !
+        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
+          !
+          ! 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)))) / 1.6
+          !
+          ! 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:
+     
+    ! for vectorization: some arrays
+  
+    !! \latexonly 
+    !!     \input{diffucocomb4.tex}
+    !! \endlatexonly
+    vegetsum(:) = zero
+
+    DO jv = 1, nvm
+
+      vegetsum(:) = vegetsum(:) + veget(:,jv)
+
+    ENDDO
+
+    vegetsum2(:) = zero
+
+    DO jv = 2, nvm
+
+      vegetsum2(:) = vegetsum2(:) + veget(:,jv)
+
+    ENDDO
+
+    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) = veget(ji,1)
+        ! 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= &
+                         &   0.000017*lai(ji,jv)**5 &
+                         & - 0.000824*lai(ji,jv)**4 &
+                         & + 0.014843*lai(ji,jv)**3 &
+                         & - 0.110112*lai(ji,jv)**2 &
+                         & + 0.205673*lai(ji,jv) &
+                         & + 0.887773
+                 ELSE
+                    coeff_dew_veg=un
+                 ENDIF
+              ELSE
+                 coeff_dew_veg=zero
+              ENDIF
+              vbeta2(ji,jv) = coeff_dew_veg*veget(ji,jv)
+             !vbeta2(ji,jv) = veget(ji,jv)
+           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
+
+
+END MODULE diffuco
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/enerbil.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/enerbil.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/enerbil.f90	(revision 854)
@@ -0,0 +1,1711 @@
+!  ==============================================================================================================================
+!  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
+  !
+  USE ioipsl
+  !
+  ! modules used :
+  USE constantes
+  USE constantes_veg
+  USE sechiba_io
+  USE parallel
+  ! 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
+  CHARACTER(LEN=80), SAVE                    :: var_name                !! To store variables names for I/O
+
+  ! 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})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsol_sat      !! Saturated specific humudity for old temperature (kg kg^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pdqsold       !! Deriv. of saturated specific humidity at old temp
+                                                                 !! (kg (kg s)^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: psnew         !! New surface static energy (J kg^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsol_sat_new  !! New saturated surface air moisture (kg kg^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: netrad        !! Net radiation (W m^{-2})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwabs         !! LW radiation absorbed by the surface (W m^{-2})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwup          !! Long-wave up radiation (W m^{-2})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: lwnet         !! Net Long-wave radiation (W m^{-2})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: fluxsubli     !! Energy of sublimation (mm day^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: qsat_air      !! Air saturated specific humidity (kg kg^{-1})
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tair          !! Air temperature (K)
+  
+  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, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef, &
+     & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, &
+     & cimean, ccanopy, emis, soilflx, soilcap, q_cdrag, humrel, fluxsens, fluxlat, &
+     & vevapp, transpir, gpp, vevapnu, vevapwet, vevapsno, 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 (-)
+    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)        :: 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)    :: 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,nvm), INTENT (out)   :: transpir         !! Transpiration (mm day^{-1})
+    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 (inout)     :: temp_sol_new     !! New soil temperature (K)
+    
+    !! 0.4 Local variables
+    REAL(r_std),DIMENSION (kjpindex)                     :: epot_air_new, qair_new
+!_ ================================================================================================================================
+    
+    !! 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)
+
+        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, soilcap, lwdown, swnet, psnew, qsol_sat_new, temp_sol_new, &
+       & qair_new, epot_air_new)
+
+    
+    !! 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, &
+       & 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, vbeta4, vbetaco2, cimean, &
+       & ccanopy, rau, u, v, q_cdrag, qair_new, humrel, vevapsno, vevapnu , vevapwet, transpir, 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(hist_id, 'netrad', kjit, netrad, kjpindex, index)
+       CALL histwrite(hist_id, 'evapot', kjit, evapot, kjpindex, index)
+       CALL histwrite(hist_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+       CALL histwrite(hist_id, 'lwdown', kjit, lwabs,  kjpindex, index)
+       CALL histwrite(hist_id, 'lwnet',  kjit, lwnet,  kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite(hist2_id, 'netrad', kjit, netrad, kjpindex, index)
+          CALL histwrite(hist2_id, 'evapot', kjit, evapot, kjpindex, index)
+          CALL histwrite(hist2_id, 'evapot_corr', kjit, evapot_corr, kjpindex, index)
+          CALL histwrite(hist2_id, 'lwdown', kjit, lwabs,  kjpindex, index)
+          CALL histwrite(hist2_id, 'lwnet',  kjit, lwnet,  kjpindex, index)
+       ENDIF
+    ELSE
+       CALL histwrite(hist_id, 'LWnet', kjit, lwnet, kjpindex, index)
+       CALL histwrite(hist_id, 'Qv', kjit, fluxsubli, kjpindex, index)
+       CALL histwrite(hist_id, 'PotEvap', kjit, evapot_corr, kjpindex, index)
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite(hist2_id, 'LWnet', kjit, lwnet, kjpindex, index)
+          CALL histwrite(hist2_id, 'Qv', kjit, fluxsubli, kjpindex, index)
+          CALL histwrite(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
+!_ ================================================================================================================================
+
+  !! 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
+
+  !! 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 HYDROLOGIC variables'
+
+        var_name='temp_sol'
+        CALL ioconf_setatt('UNITS', 'K')
+        CALL ioconf_setatt('LONG_NAME','Surface temperature')
+        CALL restget_p (rest_id, var_name, 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 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.
+        CALL setvar_p (temp_sol, val_exp,'ENERBIL_TSURF', 280._r_std)
+        
+        var_name= 'qsurf'
+        CALL ioconf_setatt('UNITS', 'g/g')
+        CALL ioconf_setatt('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('UNITS', 'mm day^{-1}')
+        CALL ioconf_setatt('LONG_NAME','Soil Potential Evaporation')
+        CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evapot, "gather", nbp_glo, index_g)
+        
+        var_name= 'evapot_corr'
+        CALL ioconf_setatt('UNITS', 'mm day^{-1}')
+        CALL ioconf_setatt('LONG_NAME','Corrected Soil Potential Evaporation')
+        IF ( ok_var(var_name) ) THEN
+           CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evapot_corr, "gather", nbp_glo, index_g)
+        ENDIF
+        
+        !Config Key  = ENERBIL_EVAPOT
+        !Config Desc = Initial Soil Potential Evaporation
+        !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. 
+        CALL setvar_p (evapot, val_exp, 'ENERBIL_EVAPOT', zero)
+        IF ( ok_var("evapot_corr") ) THEN
+           CALL setvar_p (evapot_corr, val_exp, 'ENERBIL_EVAPOT', zero)
+        ENDIF
+        
+        var_name= 'tsolrad'
+        CALL ioconf_setatt('UNITS', 'K')
+        CALL ioconf_setatt('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('UNITS', 'Kg/m^2/dt')
+        CALL ioconf_setatt('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('UNITS', 'W/m^2')
+        CALL ioconf_setatt('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('UNITS', 'W/m^2')
+        CALL ioconf_setatt('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
+        
+        ! 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('UNITS', 'gC/m**2/time step')
+          CALL ioconf_setatt('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('UNITS', 'K')
+        CALL ioconf_setatt('LONG_NAME','New Surface temperature')
+        IF ( ok_var(var_name) ) THEN
+           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
+              temp_sol_new(:) = temp_sol(:)
+           ENDIF
+        ELSE
+
+           ! initialises temp_sol_new 
+           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)
+   
+   ! ??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 (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 (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, 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)            :: 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) * (peqBcoef(ji) -  qsol_sat(ji)) / (zikq - peqAcoef(ji))
+      
+      !! \latexonly 
+      !!     \input{enerbilsurftemp5.tex}
+      !! \endlatexonly
+      lareva_old = chalev0 * (un - vbeta1(ji)) * vbeta(ji) * &
+           & (peqBcoef(ji) -  valpha(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) * 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)) * vbeta(ji) * valpha(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 / (chalev0 * (un - vbeta1(ji)) * vbeta(ji) * valpha(ji) + &
+           & chalsu0 *  vbeta1(ji)) * fevap + qsol_sat_new(ji)
+      ENDIF
+      
+    ENDDO
+
+    IF (long_print) WRITE (numout,*) ' enerbil_surftemp done '
+
+  END SUBROUTINE enerbil_surftemp
+
+
+  !!  =============================================================================================================================
+  !! 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, 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)            :: 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) * qsol_sat_new(ji) + &
+           & (un - vbeta1(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) * (qsol_sat_new(ji) - qair(ji)) + &
+           & dtradia * rau(ji) * qc * (un - vbeta1(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) *&
+           & (qsol_sat_new(ji) - qair(ji)) + &
+           &  chalev0 * rau(ji) * qc * (un - vbeta1(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) *&
+           & (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, vbeta4, vbetaco2, cimean, &
+     & ccanopy, rau, u, v, q_cdrag, qair, humrel, vevapsno, vevapnu , vevapwet, transpir, 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)       :: 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)
+    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)   :: 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,nvm), INTENT (out)  :: transpir          !! Transpiration (mm day^{-1})
+    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)                                    	:: speed	     !! Speed (m s^{-1})
+!_ ==============================================================================================================================
+    
+    !! 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) = 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)) * vbeta4(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)
+       
+      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: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/hydrol.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/hydrol.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/hydrol.f90	(revision 854)
@@ -0,0 +1,3849 @@
+!!
+!! This module computes hydrologic processes on continental points.
+!!
+!! @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 hydrol
+  !
+  !
+  ! routines called : restput, restget
+  !
+  USE ioipsl
+  !
+  ! modules used :
+  USE constantes
+  USE constantes_soil
+  USE constantes_veg
+  USE sechiba_io
+
+  ! for debug :
+  USE grid
+
+  IMPLICIT NONE
+
+  ! public routines :
+  ! hydrol
+  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
+  !
+  LOGICAL, SAVE                                     :: check_waterbal=.TRUE. !! The check the water balance
+  LOGICAL, SAVE                                     :: check_cwrr=.TRUE. !! The check the water balance
+
+  CHARACTER(LEN=80) , SAVE                          :: file_ext         !! Extention for I/O filename
+  CHARACTER(LEN=80) , SAVE                          :: var_name         !! To store variables names for I/O
+  REAL(r_std), PARAMETER                             :: drain_rest_cste = 15.0  !! time constant in days to return to free drainage after return flow
+  REAL(r_std), PARAMETER                             :: allowed_err =  1.0E-8_r_std
+  REAL(r_std), PARAMETER                             :: dmcs = 0.002     !! Allowed moisture above mcs (boundary conditions)
+  REAL(r_std), PARAMETER                             :: dmcr = 0.002     !! Allowed moisture below mcr (boundary conditions)
+  ! one dimension array allocated, computed, saved and got in hydrol module
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_water_beg    !! Total amount of water at start of time step
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_water_end    !! Total amount of water at end of time step
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watveg_beg   !! Total amount of water on vegetation at start of time step
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watveg_end   !! Total amount of water on vegetation at end of time step
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watsoil_beg  !! Total amount of water in the soil at start of time step
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tot_watsoil_end  !! Total amount of water in the soil at end of time step
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: snow_beg         !! Total amount of snow at start of time step
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: snow_end         !! Total amount of snow at end of time step
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delsoilmoist     !! Change in soil moisture
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delintercept     !! Change in interception storage
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: delswe           !! Change in SWE^Q
+
+  ! 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
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: mask_soiltype        !! zero/one where soil fraction is zero/higher 
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: mask_corr_veg_soil   !! zero/one where veg frac on a soil type is zero/higher
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: mask_return          !! zero/one where there is no/is returnflow
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: index_nsat           !! Indices of the non-saturated layers
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: index_sat            !! Indices of the saturated layers
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: n_nsat               !! Number of non-saturated layers
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: n_sat                !! Number of saturated layers
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: nslme                !! last efficient layer
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: humrelv          !! humrel for each soil type
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: vegstressv       !! vegstress for each soil type  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:):: us               !! relative humidity 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: precisol         !! Eau tombee sur le sol
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: precisol_ns      !! Eau tombee sur le sol par type de sol
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ae_ns            !! Evaporation du sol nu par type de sol
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: evap_bare_lim_ns !! limitation of bare soil evaporation on each soil column (used to deconvoluate vevapnu)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: free_drain_coef !! Coefficient for free drainage at bottom
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: rootsink         !! stress racinaire par niveau et type de sol
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: subsnowveg       !! Sublimation of snow on vegetation
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: subsnownobio     !! Sublimation of snow on other surface types (ice, lakes, ...)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: snowmelt         !! Quantite de neige fondue
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: icemelt          !! Quantite de glace fondue
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: subsinksoil      !! Excess of sublimation as a sink for the soil
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: vegtot           !! Total  vegetation
+  ! The last vegetation map which was used to distribute the reservoirs
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: resdist          !! Distribution of reservoirs
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: mx_eau_var
+
+  ! arrays used by cwrr scheme
+  REAL(r_std), SAVE, DIMENSION (nslm+1,nstm)         :: zz               !! 
+  REAL(r_std), SAVE, DIMENSION (nslm+1,nstm)         :: dz               !! 
+  REAL(r_std), SAVE, DIMENSION (imin:imax,nstm)      :: mc_lin             !! 
+  REAL(r_std), SAVE, DIMENSION (nstm)      :: v1r             !! Residual soil water content of the first layer
+  REAL(r_std), SAVE, DIMENSION (nstm)      :: vBs             !! Saturated soil water content of the bottom layer
+
+  REAL(r_std), SAVE, DIMENSION (imin:imax,nstm)      :: k_lin               !! 
+  REAL(r_std), SAVE, DIMENSION (imin:imax,nstm)      :: d_lin               !! 
+  REAL(r_std), SAVE, DIMENSION (imin:imax,nstm)      :: a_lin              !! 
+  REAL(r_std), SAVE, DIMENSION (imin:imax,nstm)      :: b_lin               !! 
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: humtot      !! (:)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: flux        !! (:)
+  LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:)         :: resolv      !! (:)
+
+
+!! linarization coefficients of hydraulic conductivity K
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: a           !! (:,nslm)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: b           !!
+!! linarization coefficients of hydraulic diffusivity D
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: d           !!
+
+!! matrix coefficients
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: e           !!
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: f           !!
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: g1          !!
+
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ep          !!
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: fp          !!
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: gp          !!
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: rhs         !!
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: srhs        !!
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: gam         !!
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc         !! (:,nstm) Total moisture content (mm)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmcs        !! (nstm) Total moisture constent at saturation (mm)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter       !! (:,nstm) Total moisture in the litter by soil type
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: tmc_litt_mea !! Total moisture in the litter over the grid
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_wilt  !! (:,nstm) Moisture of litter at wilt pt
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_field !! (:,nstm) Moisture of litter at field cap.
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_res !! (:,nstm) Moisture of litter at residual moisture.
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_sat   !! (:,nstm) Moisture of litter at saturatiion
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_awet   !! (:,nstm) Moisture of litter at mc_awet
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tmc_litter_adry   !! (:,nstm) Moisture of litter at mc_dry
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_wet_mea !! Total moisture in the litter over the grid below which albedo is fixed
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_dry_mea !! Total moisture in the litter over the grid above which albedo is fixed
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: v1          !! (:)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: vB          !! (:)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: qflux00     !! flux at the top of the soil column
+
+  !! par type de sol :
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: ru_ns       !! ruissellement
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: dr_ns       !! drainage
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: tr_ns       !! transpiration 
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: corr_veg_soil !! (:,nvm,nstm)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: corr_veg_soil_max !! (:,nvm,nstm)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: mc          !! (:,nslm,nstm) \f($m^3 \times m^3$)\f
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: soilmoist     !! (:,nslm)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: soil_wet    !! soil wetness
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: soil_wet_litter !! soil wetness of the litter
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: qflux       !! fluxes between the soil layers
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: tmat        !!
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: stmat        !!
+
+  LOGICAL, SAVE                                     :: interpol_diag=.FALSE.
+
+CONTAINS
+
+  !! 
+  !! Main routine for *hydrol* module
+  !! - called only one time for initialisation
+  !! - called every time step
+  !! - called one more time at last time step for writing _restart_ file
+  !!
+  !! Algorithm:
+  !! - call hydrol_snow for snow process (including age of snow)
+  !! - call hydrol_canop for canopy process
+  !! - call hydrol_soil for bare soil process
+  !!
+  !! @call hydrol_snow
+  !! @call hydrol_canop
+  !! @call hydrol_soil
+  !!
+  SUBROUTINE hydrol_main (kjit, kjpindex, dtradia, ldrestart_read, ldrestart_write, &
+       & index, indexveg, indexsoil, indexlayer,&
+       & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, &
+       & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,  &
+       & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, &
+       & humrel, vegstress, drysoil_frac, evapot, evapot_penm, evap_bare_lim, &
+       & shumdiag, litterhumdiag, soilcap, soiltype, rest_id, hist_id, hist2_id)
+
+    ! interface description
+    ! 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
+    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
+    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
+
+    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) :: soiltype         !! Map of soil types
+    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)      :: evapot           !! Soil Potential Evaporation
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: evapot_penm      !! Soil Potential Evaporation Correction
+    ! modified fields
+    REAL(r_std),DIMENSION (kjpindex), INTENT(out)      :: evap_bare_lim    !!
+    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     !! 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)     :: runoff           !! Complete runoff
+    REAL(r_std),DIMENSION (kjpindex), INTENT (inout)     :: drainage         !! Drainage
+    ! output fields
+    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 (inout):: shumdiag         !! relative soil moisture
+    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
+
+    !
+    ! local declaration
+    !
+    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
+    !
+    ! do initialisation
+    !
+    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, soiltype, humrel,&
+            & vegstress, snow, snow_age, snow_nobio, snow_nobio_age, qsintveg) 
+       CALL hydrol_var_init (kjpindex, veget, soiltype, mx_eau_var, shumdiag, litterhumdiag, &
+            & drysoil_frac, evap_bare_lim) 
+       !
+       ! If we check the water balance we first save the total amount of water
+       !
+       IF (check_waterbal) THEN
+          CALL hydrol_waterbal(kjpindex, index, .TRUE., dtradia, veget, &
+               & totfrac_nobio, qsintveg, snow, snow_nobio,&
+               & precip_rain, precip_snow, returnflow, irrigation, tot_melt, &
+               & vevapwet, transpir, vevapnu, vevapsno, runoff,drainage)
+       ENDIF
+       !
+       IF (almaoutput) THEN
+          CALL hydrol_alma(kjpindex, index, .TRUE., qsintveg, snow, snow_nobio, soilwet)
+       ENDIF
+
+       RETURN
+
+    ENDIF
+
+    !
+    ! 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= '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, nvm, 1, kjit,  resdist, 'scatter',  nbp_glo, index_g)       
+       RETURN
+       !
+    END IF
+
+    !
+    ! shared time step
+    !
+    IF (long_print) WRITE (numout,*) 'hydrol pas de temps = ',dtradia
+
+    ! 
+    ! computes 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)
+
+    !
+    ! computes canopy
+    !
+    !
+    CALL hydrol_vegupd(kjpindex, veget, veget_max, soiltype, qsintveg,resdist)
+    !
+
+    CALL hydrol_canop(kjpindex, precip_rain, vevapwet, veget, qsintmax, qsintveg,precisol,tot_melt)
+
+    ! computes hydro_soil
+    !
+
+    CALL hydrol_soil(kjpindex, dtradia, veget, veget_max, soiltype, transpir, vevapnu, evapot, &
+         & evapot_penm, runoff, drainage, returnflow, irrigation, &
+         & tot_melt,evap_bare_lim, shumdiag, litterhumdiag, humrel, vegstress, drysoil_frac)
+    !
+    ! If we check the water balance we end with the comparison of total water change and fluxes
+    !
+    IF (check_waterbal) THEN
+       CALL hydrol_waterbal(kjpindex, index, .FALSE., dtradia, veget, totfrac_nobio, &
+            & qsintveg, snow,snow_nobio, precip_rain, precip_snow, returnflow, &
+            & irrigation, tot_melt, vevapwet, transpir, vevapnu, vevapsno, runoff, drainage)
+    ENDIF
+    !
+    ! 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(hist_id, trim(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
+
+          ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+          WRITE (var_name,"('vegetsoil_',i1)") jst
+          CALL histwrite(hist_id, trim(var_name), kjit,corr_veg_soil(:,:,jst), kjpindex*nvm, indexveg)
+       ENDDO
+       CALL histwrite(hist_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite(hist_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite(hist_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite(hist_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
+       CALL histwrite(hist_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
+       CALL histwrite(hist_id, 'humtot', kjit, humtot, kjpindex, index)
+       CALL histwrite(hist_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'drainage', kjit, drainage, kjpindex, index)
+       CALL histwrite(hist_id, 'runoff', kjit, runoff, kjpindex, index)
+       CALL histwrite(hist_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'rain', kjit, precip_rain, kjpindex, index)
+       CALL histwrite(hist_id, 'snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite(hist_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+       IF ( hist2_id > 0 ) THEN
+          DO jst=1,nstm
+             ! var_name= "mc_1" ... "mc_3"
+             WRITE (var_name,"('moistc_',i1)") jst
+             CALL histwrite(hist2_id, trim(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
+
+             ! var_name= "vegetsoil_1" ... "vegetsoil_3"
+             WRITE (var_name,"('vegetsoil_',i1)") jst
+             CALL histwrite(hist2_id, trim(var_name), kjit,corr_veg_soil(:,:,jst), kjpindex*nvm, indexveg)
+          ENDDO
+          CALL histwrite(hist2_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite(hist2_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite(hist2_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite(hist2_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
+          CALL histwrite(hist2_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
+          CALL histwrite(hist2_id, 'humtot', kjit, humtot, kjpindex, index)
+          CALL histwrite(hist2_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'drainage', kjit, drainage, kjpindex, index)
+          CALL histwrite(hist2_id, 'runoff', kjit, runoff, kjpindex, index)
+          CALL histwrite(hist2_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'rain', kjit, precip_rain, kjpindex, index)
+          CALL histwrite(hist2_id, 'snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite(hist2_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+       ENDIF
+    ELSE
+       CALL histwrite(hist_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite(hist_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+       CALL histwrite(hist_id, 'Qs', kjit, runoff, kjpindex, index)
+       CALL histwrite(hist_id, 'Qsb', kjit, drainage, kjpindex, index)
+       CALL histwrite(hist_id, 'Qsm', kjit, tot_melt, kjpindex, index)
+       CALL histwrite(hist_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+       CALL histwrite(hist_id, 'DelSWE', kjit, delswe, kjpindex, index)
+       CALL histwrite(hist_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+       !
+       CALL histwrite(hist_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
+       CALL histwrite(hist_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+       !
+       CALL histwrite(hist_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+       CALL histwrite(hist_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+       !
+       CALL histwrite(hist_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+       !
+       IF ( hist2_id > 0 ) THEN
+          CALL histwrite(hist2_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite(hist2_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+          CALL histwrite(hist2_id, 'Qs', kjit, runoff, kjpindex, index)
+          CALL histwrite(hist2_id, 'Qsb', kjit, drainage, kjpindex, index)
+          CALL histwrite(hist2_id, 'Qsm', kjit, tot_melt, kjpindex, index)
+          CALL histwrite(hist2_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+          CALL histwrite(hist2_id, 'DelSWE', kjit, delswe, kjpindex, index)
+          CALL histwrite(hist2_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+          !
+          CALL histwrite(hist2_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
+          CALL histwrite(hist2_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+          !
+          CALL histwrite(hist2_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+          CALL histwrite(hist2_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+          !
+          CALL histwrite(hist2_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+       ENDIF
+    ENDIF
+
+    IF (long_print) WRITE (numout,*) ' hydrol_main Done '
+
+  END SUBROUTINE hydrol_main
+
+  !! Algorithm:
+  !! - dynamic allocation for local array 
+  !! - _restart_ file reading for HYDROLOGIC variables
+  !!
+  SUBROUTINE hydrol_init(kjit, ldrestart_read, kjpindex, index, rest_id, veget, soiltype, humrel,&
+       &  vegstress, snow, snow_age, snow_nobio, snow_nobio_age, qsintveg)
+
+    ! interface description
+    ! 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              !! Carte de vegetation
+    REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in)  :: soiltype         !! Map of soil types
+    ! output fields
+    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
+
+    ! local declaration
+    INTEGER(i_std)                                     :: ier, ierror, ipdt
+    INTEGER(i_std)                                     :: ji, jv, jst, jsl, ik
+
+    ! initialisation
+    IF (l_first_hydrol) THEN 
+       l_first_hydrol=.FALSE.
+    ELSE 
+       WRITE (numout,*) ' l_first_hydrol false . we stop '
+       STOP 'hydrol_init'
+    ENDIF
+
+    ! make dynamic allocation with good dimension
+
+    ! one dimension array allocation with possible restart value
+
+    ALLOCATE (mask_corr_veg_soil(kjpindex,nvm,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in  mask_corr_veg_soil allocation. We stop. We need kjpindex words = ',kjpindex*nvm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mask_veget(kjpindex,nvm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mask_veget allocation. We stop. We need kjpindex words = ',kjpindex*nvm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mask_soiltype(kjpindex,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mask_soiltype allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (mask_return(kjpindex),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mask_soiltype allocation. We stop. We need kjpindex words = ',kjpindex
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (index_nsat(kjpindex,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mask_soiltype allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (index_sat(kjpindex,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mask_soiltype allocation. We stop. We need kjpindex words = ',kjpindex*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (n_nsat(nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mask_soiltype allocation. We stop. We need kjpindex words = ',nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (n_sat(nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mask_soiltype allocation. We stop. We need kjpindex words = ',nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (nslme(kjpindex,nstm),stat=ier) 
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in mask_soiltype allocation. We stop. We need kjpindex 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 (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,nvm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in resdist allocation. We stop. We need kjpindex words = ',kjpindex*nvm
+       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 (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(nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in tmcs allocation. We stop. We need kjpindex words = ',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 (vB(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in vB 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 (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 words = ',kjpindex*nvm*nstm
+       STOP 'hydrol_init'
+    END IF
+
+    ALLOCATE (corr_veg_soil_max(kjpindex,nvm,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in corr_veg_soil_max allocation. We stop. We need kjpindex 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
+
+    !
+    !  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
+
+    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 '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
+
+    ! open restart input file done by sechiba_init
+    ! and read data from restart input file 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('UNITS', '-')
+       !
+       DO jst=1,nstm
+          ! var_name= "mc_1" ... "mc_3"
+           WRITE (var_name,"('moistc_',I1)") jst
+           CALL ioconf_setatt('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
+       !
+       CALL ioconf_setatt('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
+             CALL ioconf_setatt('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'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Coefficient for free drainage at bottom of soil')
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., free_drain_coef, "gather", nbp_glo, index_g)
+       !
+       var_name= 'ae_ns'
+       CALL ioconf_setatt('UNITS', 'kg/m^2')
+       CALL ioconf_setatt('LONG_NAME','Bare soil evap on each soil type')
+       CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., ae_ns, "gather", nbp_glo, index_g)
+       !
+       var_name= 'snow'        
+       CALL ioconf_setatt('UNITS', 'kg/m^2')
+       CALL ioconf_setatt('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('UNITS', 'd')
+       CALL ioconf_setatt('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('UNITS', 'kg/m^2')
+       CALL ioconf_setatt('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('UNITS', 'd')
+       CALL ioconf_setatt('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= 'vegstress'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('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= 'qsintveg'
+       CALL ioconf_setatt('UNITS', 'kg/m^2')
+       CALL ioconf_setatt('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('UNITS', '-')
+       CALL ioconf_setatt('LONG_NAME','Distribution of reservoirs')
+       CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., resdist, "gather", nbp_glo, index_g)
+       !
+       !
+       !
+       ! get restart values if non were found in the restart file
+       !
+       !Config Key  = HYDROL_MOISTURE_CONTENT
+       !Config Desc = Soil moisture on each soil tile and levels
+       !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.
+       !
+       CALL setvar_p (mc, val_exp, 'HYDROL_MOISTURE_CONTENT', 0.3_r_std)
+       !
+       !Config Key  = US_INIT
+       !Config Desc = US_NVM_NSTM_NSLM
+       !Config Def  = 0.0
+       !Config Help = The initial value of us 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.
+       !
+       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 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.
+       !
+       CALL setvar_p (free_drain_coef, val_exp, 'FREE_DRAIN_COEF', free_drain_max)
+       !
+       !Config Key  = EVAPNU_SOIL
+       !Config Desc = Bare soil evap on each soil if not found in restart
+       !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.
+       !
+       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 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.
+       !
+       CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero)
+       !
+       !Config Key  = HYDROL_SNOWAGE
+       !Config Desc = Initial snow age if not found in restart
+       !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.
+       !
+       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 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.
+       !
+       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 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.
+       !
+       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 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. 
+       !
+       CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero)
+       !
+       ! 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 = veget
+       ENDIF
+       !
+       !  Remember that it is only frac_nobio + SUM(veget(,:)) that is equal to 1. Thus we need vegtot
+       !
+       DO ji = 1, kjpindex
+          vegtot(ji) = SUM(veget(ji,:))
+       ENDDO
+       !
+       !
+       ! compute the masks for veget
+
+!       mask_veget(:,:) = MIN( un, MAX(zero,veget(:,:)))
+!       mask_soiltype(:,:) = MIN( un, MAX(zero,soiltype(:,:)))
+!       mask_corr_veg_soil(:,:,:) = MIN( un, MAX(zero,corr_veg_soil(:,:,:)))
+
+       mask_veget(:,:) = 0
+       mask_soiltype(:,:) = 0
+       mask_corr_veg_soil(:,:,:) = 0
+
+       mask_return(:) = 0
+       index_nsat(:,:) = 0
+       index_sat(:,:) = 0
+       n_nsat(:) = 1
+       n_sat(:) = 0
+       nslme(:,:) = nslm
+
+       DO ji = 1, kjpindex
+                    
+          DO jst = 1, nstm
+             IF(soiltype(ji,jst) .GT. min_sechiba) THEN
+                mask_soiltype(ji,jst) = 1
+             ENDIF
+          END DO
+          
+          DO jv = 1, nvm
+             IF(veget(ji,jv) .GT. min_sechiba) THEN
+                mask_veget(ji,jv) = 1
+             ENDIF
+
+             DO jst = 1, nstm
+                IF(corr_veg_soil(ji,jv,jst) .GT. min_sechiba) THEN
+                   mask_corr_veg_soil(ji,jv,jst) = 1
+                ENDIF
+             END DO
+          END DO
+          
+!      WRITE(numout,*) 'mask: soiltype,mask_soiltype',soiltype(ji,:),mask_soiltype(ji,:)
+
+       END DO
+       ! set humrelv from us
+
+       humrelv(:,:,:) = SUM(us,dim=4)
+       vegstressv(:,:,:) = SUM(us,dim=4)
+       ! set humrel from humrelv
+
+       humrel(:,:) = zero
+
+       DO jst=1,nstm
+          DO jv=1,nvm
+             DO ji=1,kjpindex
+
+                vegstress(ji,jv)=vegstress(ji,jv) + vegstressv(ji,jv,jst) * soiltype(ji,jst)
+
+!                IF(veget(ji,jv).NE.zero) THEN
+                   humrel(ji,jv)=humrel(ji,jv) + humrelv(ji,jv,jst) * & 
+                        & soiltype(ji,jst)
+                   humrel(ji,jv)=MAX(humrel(ji,jv), zero)* mask_veget(ji,jv)           
+!                ELSE
+!                   humrel(ji,jv)= zero
+!                ENDIF
+             END DO
+          END DO
+       END DO
+!       vegstress(:,:)=humrel(:,:)
+    ENDIF
+    !
+    !
+    IF (long_print) WRITE (numout,*) ' hydrol_init done '
+    !
+  END SUBROUTINE hydrol_init
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE hydrol_clear()
+
+    l_first_hydrol=.TRUE.
+    IF (ALLOCATED (mask_veget)) DEALLOCATE (mask_veget)
+    IF (ALLOCATED (mask_soiltype)) DEALLOCATE (mask_soiltype)
+    IF (ALLOCATED (mask_corr_veg_soil)) DEALLOCATE (mask_corr_veg_soil)
+    IF (ALLOCATED (mask_return)) DEALLOCATE (mask_return)
+    IF (ALLOCATED (index_nsat)) DEALLOCATE (index_nsat)
+    IF (ALLOCATED (index_sat)) DEALLOCATE (index_sat)
+    IF (ALLOCATED (n_nsat)) DEALLOCATE (n_nsat)
+    IF (ALLOCATED (n_sat)) DEALLOCATE (n_sat)
+    IF (ALLOCATED (nslme)) DEALLOCATE (nslme)
+    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  (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_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)
+    ! more allocation for cwrr scheme
+    IF (ALLOCATED  (v1)) DEALLOCATE (v1)
+    IF (ALLOCATED  (vB)) DEALLOCATE (vB)
+    IF (ALLOCATED  (humtot)) DEALLOCATE (humtot)
+    IF (ALLOCATED  (flux)) DEALLOCATE (flux)
+    IF (ALLOCATED  (resolv)) DEALLOCATE (resolv)
+    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  (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  (corr_veg_soil)) DEALLOCATE (corr_veg_soil)
+    IF (ALLOCATED  (corr_veg_soil_max)) DEALLOCATE (corr_veg_soil_max)
+    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)
+
+    RETURN 
+
+  END SUBROUTINE hydrol_clear
+
+  !! This routine initializes HYDROLOGIC variables
+  !! - mx_eau_var
+
+  SUBROUTINE hydrol_var_init (kjpindex, veget, soiltype, mx_eau_var, shumdiag, litterhumdiag, drysoil_frac, evap_bare_lim) 
+
+    ! interface description
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                          :: kjpindex      !! domain size
+    ! input fields
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)   :: veget         !! fraction of vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltype      !! Map of soil types
+    ! output fields
+    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)      :: 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 !! 
+    ! local declaration
+    REAL(r_std), DIMENSION (kjpindex)              :: dpu_mean  !! mean soil depth
+
+    INTEGER(i_std)                                     :: ji, jv, jd, jst, jsl
+    REAL(r_std)                                         :: m, frac
+    !
+    ! initialisation
+    mx_eau_var(:) = zero
+    dpu_mean(:)= zero
+    !
+    DO ji = 1,kjpindex
+       DO jst = 1,nstm
+          dpu_mean(ji)=dpu_mean(ji)+dpu(jst)*soiltype(ji,jst)
+       END DO
+    END DO
+    !
+    DO ji = 1,kjpindex
+       DO jst = 1,nstm
+          mx_eau_var(ji) = mx_eau_var(ji) + soiltype(ji,jst)*&
+               &   dpu(jst)*mille*mcs(jst)
+       END DO
+    END DO
+
+    DO ji = 1,kjpindex 
+       IF (vegtot(ji) .LE. zero) THEN
+          mx_eau_var(ji) = mx_eau_eau*deux
+       ENDIF
+
+    END DO
+
+
+    !
+    ! 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.
+    !
+    DO jst=1,nstm
+       m = un - un / nvan(jst)
+       !       WRITE(numout,*) 'jst',jst,imin,imax
+       mc_lin(imin,jst)=mcr(jst)
+       mc_lin(imax,jst)=mcs(jst)
+       tmcs(jst)=dpu(jst)* mille*mcs(jst)
+       zz(1,jst) = zero
+       dz(1,jst) = zero
+       DO jsl=2,nslm
+          zz(jsl,jst) = dpu(jst)* mille*((2**(jsl-1))-1)/ ((2**(nslm-1))-1)
+          dz(jsl,jst) = zz(jsl,jst)-zz(jsl-1,jst)
+          !          WRITE(numout,*) 'jsl, zz,dz',jsl, dpu(jst),zz(jsl,jst),dz(jsl,jst)
+       ENDDO
+       zz(nslm+1,jst) = zz(nslm,jst)
+       dz(nslm+1,jst) = zero
+       DO ji= imin+1, imax-1 
+          mc_lin(ji,jst) = mcr(jst) + (ji-imin)*(mcs(jst)-mcr(jst))/(imax-imin)
+       ENDDO
+       DO ji = imin,imax-1 
+          frac=MIN(un,(mc_lin(ji,jst)-mcr(jst))/(mcs(jst)-mcr(jst)))
+          k_lin(ji,jst) = ks(jst) * (frac**0.5) * ( un - ( un - frac ** (un/m)) ** m )**2
+          frac=MIN(un,(mc_lin(ji+1,jst)-mcr(jst))/(mcs(jst)-mcr(jst)))
+          k_lin(ji+1,jst) = ks(jst) * (frac**0.5) * ( un - ( un - frac ** (un/m)) ** m )**2
+          a_lin(ji,jst) = (k_lin(ji+1,jst)-k_lin(ji,jst)) / (mc_lin(ji+1,jst)-mc_lin(ji,jst))
+          b_lin(ji,jst)  = k_lin(ji,jst) - a_lin(ji,jst)*mc_lin(ji,jst)
+          !- Il faudrait ici definir a et b pour mc > mcs, et mc < mcr car c'est un cas auquel on peut etre confronte... a reflechir
+
+          IF(ji.NE.imin.AND.ji.NE.imax-1) THEN
+             frac=MIN(un,(mc_lin(ji,jst)-mcr(jst))/(mcs(jst)-mcr(jst)))
+             d_lin(ji,jst) =(k_lin(ji,jst) / (avan(jst)*m*nvan(jst))) *  &
+                  &  ( (frac**(-un/m))/(mc_lin(ji,jst)-mcr(jst)) ) * &
+                  &  (  frac**(-un/m) -un ) ** (-m)
+             frac=MIN(un,(mc_lin(ji+1,jst)-mcr(jst))/(mcs(jst)-mcr(jst)))
+             d_lin(ji+1,jst) =(k_lin(ji+1,jst) / (avan(jst)*m*nvan(jst)))*&
+                  &  ( (frac**(-un/m))/(mc_lin(ji+1,jst)-mcr(jst)) ) * &
+                  &  (  frac**(-un/m) -un ) ** (-m)
+             d_lin(ji,jst) = undemi * (d_lin(ji,jst)+d_lin(ji+1,jst))
+          ELSEIF(ji.EQ.imin) THEN
+             d_lin(ji,jst) = zero
+          ELSEIF(ji.EQ.imax-1) THEN
+             frac=MIN(un,(mc_lin(ji,jst)-mcr(jst))/(mcs(jst)-mcr(jst)))
+             d_lin(ji,jst) =(k_lin(ji,jst) / (avan(jst)*m*nvan(jst))) * &
+                  & ( (frac**(-un/m))/(mc_lin(ji,jst)-mcr(jst)) ) *  &
+                  & (  frac**(-un/m) -un ) ** (-m)
+          ENDIF
+       ENDDO
+    ENDDO
+
+
+
+    ! Compute the litter humidity, shumdiag and fry
+
+    litterhumdiag(:) = zero
+    tmc_litt_mea(:) = zero
+    tmc_litt_wet_mea(:) = zero
+    tmc_litt_dry_mea(:) = zero
+    shumdiag(:,:) = zero
+    soilmoist(:,:) = zero
+    humtot(:) = zero
+    tmc(:,:) = zero
+
+    ! Loop on soil types to compute the variables (ji,jst)
+
+    DO jst=1,nstm 
+
+       ! the residual 1st layer soil moisture:
+       v1r(jst) = dz(2,jst)*mcr(jst)/deux
+
+       ! the saturated Bottom layer soil moisture: 
+       ! v A CALCULER SUR TOUT LE PROFIL (vs et vr egalement)
+       vBs(jst) = dz(nslm,jst)*mcs(jst)/deux
+       
+       ! The total soil moisture for each soil type:
+
+       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
+       END DO
+
+
+       ! The litter variables:
+
+       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(jst) / deux
+          tmc_litter_res(ji,jst) = dz(2,jst) * mcr(jst) / deux
+          tmc_litter_field(ji,jst) = dz(2,jst) * mcf(jst) / deux
+          tmc_litter_sat(ji,jst) = dz(2,jst) * mcs(jst) / deux
+          tmc_litter_awet(ji,jst) = dz(2,jst) * mc_awet(jst) / deux
+          tmc_litter_adry(ji,jst) = dz(2,jst) * mc_adry(jst) / deux
+       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
+
+             tmc_litter_wilt(ji,jst) = tmc_litter_wilt(ji,jst) + &
+                  &(dz(jsl,jst)+ dz(jsl+1,jst))*& 
+                  & mcw(jst)/deux
+             tmc_litter_res(ji,jst) = tmc_litter_res(ji,jst) + &
+                  &(dz(jsl,jst)+ dz(jsl+1,jst))*& 
+                  & mcr(jst)/deux
+             tmc_litter_sat(ji,jst) = tmc_litter_sat(ji,jst) + &
+                  &(dz(jsl,jst)+ dz(jsl+1,jst))* & 
+                  & mcs(jst)/deux
+             tmc_litter_field(ji,jst) = tmc_litter_field(ji,jst) + &
+                  & (dz(jsl,jst)+ dz(jsl+1,jst))* & 
+                  & mcf(jst)/deux
+             tmc_litter_awet(ji,jst) = tmc_litter_awet(ji,jst) + &
+                  &(dz(jsl,jst)+ dz(jsl+1,jst))* & 
+                  & mc_awet(jst)/deux
+             tmc_litter_adry(ji,jst) = tmc_litter_adry(ji,jst) + &
+                  & (dz(jsl,jst)+ dz(jsl+1,jst))* & 
+                  & mc_adry(jst)/deux
+          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)
+
+       DO ji=1,kjpindex
+          soil_wet(ji,1,jst) = MIN(un, MAX(zero,&
+               &(trois*mc(ji,1,jst) + mc(ji,2,jst) - quatre*mcw(jst))&
+               & /(quatre*(mcs(jst)-mcw(jst))) ))
+          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(jst)) / (quatre*(mcs(jst)-mcw(jst))) ))
+          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(jst))/(quatre*(mcs(jst)-mcw(jst))) ))
+       END DO
+
+    END DO ! loop on soil type
+
+
+    !Now we compute the grid averaged values:
+
+    DO jst=1,nstm        
+       DO ji=1,kjpindex
+
+          humtot(ji) = humtot(ji) + soiltype(ji,jst) * tmc(ji,jst)
+
+          litterhumdiag(ji) = litterhumdiag(ji) + &
+               & soil_wet_litter(ji,jst) * soiltype(ji,jst)
+
+          tmc_litt_wet_mea(ji) =  tmc_litt_wet_mea(ji) + & 
+               & tmc_litter_awet(ji,jst)* soiltype(ji,jst)
+
+          tmc_litt_dry_mea(ji) = tmc_litt_dry_mea(ji) + &
+               & tmc_litter_adry(ji,jst) * soiltype(ji,jst) 
+
+          tmc_litt_mea(ji) = tmc_litt_mea(ji) + &
+               & tmc_litter(ji,jst) * soiltype(ji,jst) 
+       END DO
+
+
+
+       DO jsl=1,nbdl
+          DO ji=1,kjpindex
+             shumdiag(ji,jsl)= shumdiag(ji,jsl) + soil_wet(ji,jsl,jst) * &
+                  & ((mcs(jst)-mcw(jst))/(mcf(jst)-mcw(jst))) * &
+                  & soiltype(ji,jst)
+             soilmoist(ji,jsl) = soilmoist(ji,jsl) + mc(ji,jsl,jst)*soiltype(ji,jst)
+             shumdiag(ji,jsl) = MAX(MIN(shumdiag(ji,jsl), un), zero) 
+          END DO
+       END DO
+
+    END DO ! loop on soiltype
+    !
+    !
+    !
+    DO ji=1,kjpindex
+       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)
+    END DO
+
+    evap_bare_lim = zero
+
+!!$    IF ( COUNT(diaglev .EQ. undef_sechiba) > 0 ) THEN
+!!$
+!!$       DO jsl=1,nbdl-1
+!!$          diaglev(jsl) = zz(jsl,1) + dz(jsl+1,1)/deux
+!!$       END DO
+!!$       diaglev(nbdl) = zz(nbdl,1)
+!!$       interpol_diag = .FALSE.
+!!$
+!!$    ENDIF
+
+    IF (long_print) WRITE (numout,*) ' hydrol_var_init done '
+
+  END SUBROUTINE hydrol_var_init
+
+  !! This routine computes snow processes
+  !!
+  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
+    ! 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+ ...
+    ! modified fields
+    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, ...
+    ! output fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: tot_melt      !! Total melt  
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: snowdepth     !! Snow depth
+    !
+    ! local declaration
+    !
+    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. It is snowing
+       !
+       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.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. 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
+    !
+    ! 2. On Land ice
+    !
+    DO ji=1,kjpindex
+       !
+       ! 2.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)
+       !
+       ! 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 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
+
+    !
+    ! 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.0 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
+
+  !! This routine computes canopy processes
+  !!
+  SUBROUTINE hydrol_canop (kjpindex, precip_rain, vevapwet, veget, qsintmax, &
+       & qsintveg,precisol,tot_melt)
+
+    ! 
+    ! interface description
+    !
+    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       !! 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
+    ! modified fields
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout)     :: qsintveg    !! Water on vegetation due to interception
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out)           :: precisol    !! Eau tombee sur le sol
+    ! output fields
+
+    !
+    ! local declaration
+    !
+    INTEGER(i_std)                                :: ji, jv
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: zqsintvegnew
+    LOGICAL, SAVE                                  :: firstcall=.TRUE.
+    REAL(r_std), SAVE, DIMENSION(nvm)              :: throughfall_by_pft
+
+    IF ( firstcall ) THEN
+       !Config  Key  = PERCENT_THROUGHFALL_PFT
+       !Config  Desc = Percent by PFT of precip that is not intercepted by the canopy
+       !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.
+       
+       throughfall_by_pft = (/ 30., 30., 30., 30., 30., 30., 30., 30., 30., 30., 30., 30., 30. /)
+       CALL getin_p('PERCENT_THROUGHFALL_PFT',throughfall_by_pft)
+       throughfall_by_pft = throughfall_by_pft / 100.
+
+       firstcall=.FALSE.
+    ENDIF
+
+
+    ! 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(:)
+       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(:,:) = 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)
+          precisol(ji,jv) = (veget(ji,jv)*throughfall_by_pft(jv)*precip_rain(ji)) + qsintveg(ji,jv ) - zqsintvegnew (ji,jv)
+       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(ji,jv)/vegtot(ji)
+          ENDIF
+       ENDDO
+    END DO
+    !   
+    !
+    ! 1.4 swap qsintveg to the new value
+    !
+
+    DO jv=1,nvm
+       qsintveg(:,jv) = zqsintvegnew (:,jv)
+    END DO
+
+    IF (long_print) WRITE (numout,*) ' hydrol_canop done '
+
+  END SUBROUTINE hydrol_canop
+  !!
+  !!
+  !!
+  SUBROUTINE hydrol_vegupd(kjpindex, veget, veget_max, soiltype,qsintveg,resdist)
+    !
+    !   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.
+    !
+    ! 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)      :: soiltype         !! Map of soil types : proportion of each soil type
+    ! modified fields
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout)  :: qsintveg           !! Water on vegetation
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(inout)    :: resdist          !! Old vegetation map
+    !
+    ! local declaration
+    !
+    INTEGER(i_std)                                :: ji,jv,jst,jst_pref
+    REAL(r_std), DIMENSION (kjpindex,nstm)         :: soil_exist,soil_exist_max
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: veget_exist,veget_exist_max
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: qsintveg2                   !! Water on vegetation due to interception over old veget
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: vmr                         !! variation of veget
+    REAL(r_std), DIMENSION (kjpindex,nvm)          :: qsdq
+    REAL(r_std), DIMENSION(kjpindex)               :: vegchtot,vtr, qstr, fra
+    REAL(r_std), PARAMETER                         :: EPS1 = EPSILON(un)
+    !
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+!mask
+!           vmr(ji,jv) = MAX ( EPSILON(un), MIN (  veget(ji,jv)-resdist(ji,jv) , MAX( EPSILON(un), veget(ji,jv)-resdist(ji,jv))  ) )
+                
+!            vmr(ji,jv) = MAX ( EPSILON(un),  MAX( EPSILON(un), veget(ji,jv)-resdist(ji,jv))  )
+!            IF(ABS(veget(ji,jv)-resdist(ji,jv)).gt.epsilon(un)) then
+!    WRITE(numout,*) '-----------------------------------------------'
+!    WRITE(numout,*) 'vmr,epsilon(un),veget,resdist',vmr(ji,jv),epsilon(un)
+!    WRITE(numout,*),veget(ji,jv),resdist(ji,jv)
+!    WRITE(numout,*) 'ABS(veget -resdist',ABS(veget(ji,jv)-resdist(ji,jv))
+!      endif
+          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
+          !
+          IF (resdist(ji,jv) .GT. min_sechiba) THEN
+             qsintveg2(ji,jv) = qsintveg(ji,jv)/resdist(ji,jv)
+          ELSE
+             qsintveg2(ji,jv) = zero
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    vegchtot(:) = zero
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          vegchtot(ji) = vegchtot(ji) + ABS( vmr(ji,jv) )
+       ENDDO
+    ENDDO
+    !
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          IF ( vegchtot(ji) .GT. min_sechiba ) THEN
+             qsdq(ji,jv) = ABS(vmr(ji,jv)) * qsintveg2(ji,jv)
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! calculate water mass that we have to redistribute
+    !
+    qstr(:) = zero
+    vtr(:) = zero
+    !
+    !
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          IF ( ( vegchtot(ji) .GT. min_sechiba ) .AND. ( vmr(ji,jv) .LT. -min_sechiba ) ) THEN
+             qstr(ji) = qstr(ji) + qsdq(ji,jv)
+             vtr(ji) = vtr(ji) - vmr(ji,jv)
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    ! put it into reservoir of plant whose surface area has grown
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          IF ( vegchtot(ji) .GT. min_sechiba .AND. ABS(vtr(ji)) .GT. EPSILON(un)) THEN
+             fra(ji) = vmr(ji,jv) / vtr(ji)
+             IF ( vmr(ji,jv) .GT. min_sechiba)  THEN
+                qsintveg(ji,jv) = qsintveg(ji,jv) + fra(ji)* qstr(ji)
+             ELSE
+                qsintveg(ji,jv) = qsintveg(ji,jv) - qsdq(ji,jv)
+             ENDIF
+          ENDIF
+       ENDDO
+    ENDDO
+!MM underflow :
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+         IF ( ABS(qsintveg(ji,jv)) > zero .AND. ABS(qsintveg(ji,jv)) < EPS1 ) THEN
+            qsintveg(ji,jv) = EPS1
+         ENDIF
+      ENDDO
+   ENDDO
+
+    !   Now that the work is done resdist needs an update !
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          resdist(ji,jv) = veget(ji,jv)
+       ENDDO
+    ENDDO
+
+
+    ! Distribution of the vegetation depending on the soil type
+
+!    DO jst = 1, nstm
+!
+!       DO ji = 1, kjpindex
+!
+!           
+!          soil_exist(ji,jst)=zero
+!          IF (soiltype(ji,jst) .NE. zero) THEN
+!             soil_exist(ji,jst)=un
+!             soil_exist_max(ji,jst)=un
+!          ENDIF
+!
+!       ENDDO
+!
+!    ENDDO
+
+    soil_exist(:,:) = mask_soiltype(:,:)
+    soil_exist_max(:,:) = mask_soiltype(:,:)
+    veget_exist(:,:) = zero
+    veget_exist_max(:,:) = zero
+
+    DO jv = 1, nvm
+
+       DO ji = 1, kjpindex
+          IF(vegtot(ji).GT.min_sechiba) THEN
+             veget_exist(ji,jv)= veget(ji,jv)/vegtot(ji)
+             veget_exist_max(ji,jv)= veget_max(ji,jv)/vegtot(ji)
+          ENDIF
+       ENDDO
+    ENDDO
+
+    ! Compute corr_veg_soil 
+
+    corr_veg_soil(:,:,:) = zero
+    corr_veg_soil_max(:,:,:) = zero
+
+    IF ( COUNT(pref_soil_veg .EQ. 0) > 0 ) THEN
+
+       DO jst = 1, nstm
+
+          DO jv = nvm, 1, -1
+
+             DO ji=1,kjpindex
+
+                IF(vegtot(ji).GT.min_sechiba.AND.soiltype(ji,jst).GT.min_sechiba) THEN
+                   corr_veg_soil(ji,jv,jst) = veget(ji,jv)/vegtot(ji)
+                   corr_veg_soil_max(ji,jv,jst) = veget_max(ji,jv)/vegtot(ji)
+                END IF
+
+             END DO
+          END DO
+       END DO
+
+    ELSE
+
+
+       DO jst = 1, nstm
+
+          DO jv = nvm, 1, -1
+
+             jst_pref = pref_soil_veg(jv,jst)
+
+             DO ji=1,kjpindex
+                corr_veg_soil(ji,jv,jst_pref) = zero
+                corr_veg_soil_max(ji,jv,jst_pref) = zero
+                !for veget distribution used in sechiba via humrel
+                IF (soil_exist(ji,jst_pref).GT.min_sechiba) THEN
+                   corr_veg_soil(ji,jv,jst_pref)=MIN(veget_exist(ji,jv)/soiltype(ji,jst_pref),soil_exist(ji,jst_pref))
+                   veget_exist(ji,jv)=MAX(veget_exist(ji,jv)-soil_exist(ji,jst_pref)*soiltype(ji,jst_pref),zero)
+                   soil_exist(ji,jst_pref)=MAX(soil_exist(ji,jst_pref)-corr_veg_soil(ji,jv,jst_pref),zero)
+                ENDIF
+                !same for max veget_max used in stomate via vegstress for slowproc
+                IF (soil_exist_max(ji,jst_pref).GT.min_sechiba) THEN
+                   corr_veg_soil_max(ji,jv,jst_pref)= &
+               &     MIN(veget_exist_max(ji,jv)/soiltype(ji,jst_pref),soil_exist_max(ji,jst_pref))
+                   veget_exist_max(ji,jv)=MAX(veget_exist_max(ji,jv)-soil_exist_max(ji,jst_pref)*soiltype(ji,jst_pref),zero)
+                   soil_exist_max(ji,jst_pref)=MAX(soil_exist_max(ji,jst_pref)-corr_veg_soil_max(ji,jv,jst_pref),zero)
+                ENDIF 
+             ENDDO
+
+          ENDDO
+
+       ENDDO
+      ENDIF
+      !
+      ! update the corresponding masks
+      !
+!       mask_veget(:,:) = MIN( un, MAX(zero,veget(:,:)))
+!       mask_corr_veg_soil(:,:,:) = MIN( un, MAX(zero,corr_veg_soil(:,:,:)))
+
+       mask_veget(:,:) = 0
+       mask_corr_veg_soil(:,:,:) = 0
+
+       DO ji = 1, kjpindex
+
+          DO jv = 1, nvm
+             IF(veget(ji,jv) .GT. min_sechiba) THEN
+                mask_veget(ji,jv) = 1
+             ENDIF
+          
+             DO jst = 1, nstm
+                IF(corr_veg_soil(ji,jv,jst) .GT. min_sechiba) THEN
+                   mask_corr_veg_soil(ji,jv,jst) = 1
+                ENDIF
+             END DO
+          END DO
+          
+!      WRITE(numout,*) 'mask: soiltype,mask_soiltype',soiltype(ji,:),mask_soiltype(ji,:)
+
+       END DO
+      !
+
+    RETURN
+    !
+  END SUBROUTINE hydrol_vegupd
+  !!
+  !! this routine computes soil processes with CWRR scheme
+  !!
+  SUBROUTINE hydrol_soil (kjpindex, dtradia, veget, veget_max, soiltype, transpir, vevapnu, evapot, &
+       & evapot_penm, runoff, drainage, returnflow, irrigation, &
+       & tot_melt, evap_bare_lim,  shumdiag, litterhumdiag, humrel,vegstress, drysoil_frac)
+    ! 
+    ! interface description
+    ! 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,nvm), INTENT (in)       :: veget            !! Map of vegetation types
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)       :: veget_max        !! Map of max vegetation types
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltype         !! Map of soil types
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in)        :: transpir         !! transpiration
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu          !! 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: returnflow       !! Water returning to the deep reservoir
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: irrigation       !! Irrigation 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot           !! 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot_penm      !! 
+    ! modified fields
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: runoff           !! complete runoff
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: drainage         !! complete drainage
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_melt
+    REAL(r_std), DIMENSION (kjpindex), INTENT(out)           :: evap_bare_lim    !!
+    REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (out)     :: shumdiag         !! relative soil moisture
+    REAL(r_std), DIMENSION (kjpindex), INTENT (out)          :: litterhumdiag    !! litter humidity
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (inout)    :: 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 the litter humidity, that will be used to compute albedo
+    !
+    ! local declaration
+    !
+    INTEGER(i_std)                                :: ji, jv, jsl, jsl1, jst, ji_nsat  !! indices
+    INTEGER(i_std)                                :: m_sl0, m_sl1, isat !! mask values
+    REAL(r_std)                                    :: dztmp                       !! temporary depth
+    REAL(r_std)                                    :: temp                        !! temporary value for fluxes
+    REAL(r_std)                                    :: dpue                        !! temporary depth
+    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
+    REAL(r_std), DIMENSION(kjpindex)               :: correct_excess             !! Corrects the flux at nslme layer in case of under residual moisture 
+    REAL(r_std), DIMENSION(kjpindex)               :: mce                        !! Same use as mcint but jut for last efficient layer nslme 
+    REAL(r_std), DIMENSION(kjpindex)               :: under_mcr                  !! Allows under residual soil moisture due to evap 
+    REAL(r_std), DIMENSION(kjpindex,nstm)          :: v2
+    REAL(r_std), DIMENSION(kjpindex,nstm)          :: evap_bare_lim_ns           !! limitation of bare soi evaporation on each soil column (used to deconvoluate vevapnu)
+    REAL(r_std)                                    :: deltahum,diff
+    REAL(r_std), DIMENSION(kjpindex)               :: tsink
+    REAL(r_std), DIMENSION(kjpindex)               :: returnflow_soil
+    REAL(r_std), DIMENSION(kjpindex)               :: irrigation_soil
+    REAL(r_std), DIMENSION(kjpindex,nstm)          :: runoff_excess              !! Runoff generated after soil saturation
+    REAL(r_std)                                    :: excess
+    LOGICAL                                       :: propagate                  !! if we propagate an excess
+    !
+    !
+    returnflow_soil(:) = zero
+    irrigation_soil(:) = zero
+    qflux(:,:,:) = zero
+    mask_return(:) = 0
+    index_nsat(:,:) = 0
+    index_sat(:,:) = 0
+    nslme(:,:) = nslm
+    runoff_excess(:,:) = zero
+    mce(:) = zero
+    under_mcr(:) = zero
+    correct_excess(:) = zero
+    free_drain_coef(:,:) = zero
+    n_sat(:) = 0
+    n_nsat(:) = 1
+    !
+    ! split 2d variables to 3d variables, per soil type
+    !
+        CALL hydrol_split_soil (kjpindex, veget, soiltype, vevapnu, transpir, humrel, evap_bare_lim)
+    !
+    ! for each soil type
+    !
+    DO ji=1,kjpindex
+       IF(vegtot(ji).GT.min_sechiba) THEN
+          returnflow_soil(ji) = returnflow(ji)/vegtot(ji)
+          irrigation_soil(ji) = irrigation(ji)/vegtot(ji)
+       ENDIF
+
+       DO jst=1, nstm
+          !- A priori on considere qu'on est non sature si soiltype > 0
+          index_nsat(n_nsat(jst),jst)= ji*mask_soiltype(ji,jst)
+          n_nsat(jst)=n_nsat(jst)+mask_soiltype(ji,jst)
+       ENDDO
+       
+       IF(returnflow_soil(ji).GT.min_sechiba) THEN 
+          mask_return(ji) = 1
+          DO jst= 1,nstm
+             isat=1
+             nslme(ji,jst)=nslm-isat
+             !
+             DO jsl= nslm,3,-1
+                IF(mcs(jst)-mc(ji,jsl,jst).LT.min_sechiba) THEN 
+                   nslme(ji,jst) = nslme(ji,jst) - isat
+                ELSE
+                   isat = 0
+                ENDIF
+             ENDDO
+             ! We compute the indeces of the non-saturated points
+             IF (nslme(ji,jst).LT.2) THEN
+                nslme(ji,jst) = 0
+                ! En fait on est sature!
+                n_nsat(jst)=n_nsat(jst)-1
+                n_sat(jst) = n_sat(jst)+1
+                index_sat(n_sat(jst),jst)=ji
+             ENDIF
+          ENDDO
+       ENDIF
+    ENDDO
+
+    DO jst = 1,nstm
+       n_nsat(jst) = n_nsat(jst)-1
+    ENDDO
+
+    DO jst = 1,nstm
+       !
+       !- We compute the sum of the sinks for future check-up
+       DO ji=1,kjpindex
+          tsink(ji) = SUM(rootsink(ji,:,jst))+MAX(ae_ns(ji,jst),zero)+subsinksoil(ji)
+       ENDDO
+
+       ! We save the Total moisture content
+       tmcold(:) = tmc(:,jst)
+
+       DO ji_nsat=1,n_nsat(jst)
+          ji = index_nsat(ji_nsat,jst)
+
+          !- the bare soil evaporation is substracted to the soil moisture profile:  
+
+          dpue = zz(nslme(ji,jst),jst) + dz(nslme(ji,jst)+1,jst) / deux
+          DO jsl = 1, nslme(ji,jst)
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) &
+                  & - (MAX(ae_ns(ji,jst),zero) + subsinksoil(ji)) / dpue
+          ENDDO
+
+          !- we add the returnflow to the last efficient layer in the soil
+          mc(ji,nslme(ji,jst),jst) = mc(ji,nslme(ji,jst),jst) + deux * returnflow_soil(ji) &
+               & / (dz(nslme(ji,jst),jst) + dz(nslme(ji,jst)+1,jst))
+
+       ENDDO
+
+!!! SUBROUTINE hydrol_avoid_underres
+       !-when mc(ji,1,jst)<mcr, we put it to mcr:
+       ! Smooth the profile to avoid negative values of ponctual soil moisture:
+
+       DO ji_nsat=1,n_nsat(jst)
+          ji = index_nsat(ji_nsat,jst)
+          !
+          ! Shifts water lack from top to bottom for under-residual moisture cases
+          DO jsl = 1,nslm-1
+             excess = MAX(mcr(jst)-mc(ji,jsl,jst),zero)
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) + excess
+             mc(ji,jsl+1,jst) = mc(ji,jsl+1,jst) - excess * &
+                  &  (dz(jsl,jst)+dz(jsl+1,jst))/(dz(jsl+1,jst)+dz(jsl+2,jst))
+          ENDDO
+          
+          excess = MAX(mcr(jst)-mc(ji,nslm,jst),zero)
+          mc(ji,nslm,jst) = mc(ji,nslm,jst) + excess
+          
+          !- Then if the soil moisture at bottom is not sufficient, we try to refill the column from the top
+          DO jsl = nslm-1,1,-1
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) - excess * &
+                  &  (dz(jsl+1,jst)+dz(jsl+2,jst))/(dz(jsl+1,jst)+dz(jsl,jst))
+             excess = MAX(mcr(jst)-mc(ji,jsl,jst),zero)
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) + excess
+          ENDDO
+          
+          excess = excess * mask_soiltype(ji,jst)
+          mc(ji,:,jst) = mc(ji,:,jst) * mask_soiltype(ji,jst)
+          
+          ! Keep the value in case excess is still positive (due to big change in evapot)
+          under_mcr(ji) = excess * dz(2,jst)/2
+       END DO
+!!! END SUBROUTINE hydrol_avoid_underres
+
+       !-we keep the value of mc in mcint:
+
+       DO jsl = 1, nslm
+          DO ji = 1, kjpindex
+             mcint(ji,jsl) = mc(ji,jsl,jst) - under_mcr(ji) / (dpu(jst) * mille)
+          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
+       END DO
+       !
+       DO ji = 1, kjpindex
+          tmcint(ji) = tmcint(ji) + dz(nslm,jst) &
+               & * (trois * mcint(ji,nslm) + mcint(ji,nslm-1))/huit
+       ENDDO
+       
+       !- On retire les termes puits de la transpiration des couches inactives a la premiere couche inactive.
+       DO ji_nsat=1,n_nsat(jst)
+          ji = index_nsat(ji_nsat,jst)
+
+          DO jsl = nslme(ji,jst)+1,nslm                   ! Allows to use mc(ji,nslme(ji,jst)+1,jst)
+             mc(ji,nslme(ji,jst)+1,jst) = mc(ji,nslme(ji,jst)+1,jst) & 
+                  & - deux * rootsink(ji,jsl,jst) / & 
+                  & (dz(nslme(ji,jst)+1,jst) + dz(nslme(ji,jst)+2,jst))       
+             !- ATTENTION: n'est pas traite le cas ou la premiere couche inactive ne peut satisfaire la demande en eau des racines en dessous:
+             !- Le cas ne devrait pas se poser a priori
+             
+          ENDDO
+       ENDDO
+
+       !- Some initialisation necessary for the diffusion scheme to work
+       DO ji_nsat=1,n_nsat(jst)
+          ji = index_nsat(ji_nsat,jst)
+          !
+          ! 
+          !
+          !- 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))
+          !- estimate maximum surface flux in mm/step, assuming 
+          !- all available water
+          flux(ji) = zero
+
+          IF(vegtot(ji).GT.min_sechiba) THEN
+             flux(ji) = precisol_ns(ji,jst) - evapot_penm(ji)*&
+                  & AINT(corr_veg_soil(ji,1,jst)+un-min_sechiba) &
+                  & + irrigation_soil(ji)            
+          ENDIF
+          !- The incoming flux is first dedicated to fill the soil up to mcr (in case needed)
+          temp = MAX(MIN(flux(ji),under_mcr(ji)), zero)
+          flux(ji) = flux(ji) - temp
+          under_mcr(ji) = under_mcr(ji) - temp
+       END DO
+
+       !- module to implement dublin model for one time-step
+       !-	gravity drainage as lower boundary layer
+       !- m.bruen, CWRR, ucd. 
+       !
+       !-step3: matrix resolution
+       !-calcul of the matrix coefficients
+
+       !- coefficient are computed depending on the profile mcint:
+
+       CALL hydrol_soil_setup(kjpindex,jst,dtradia)
+
+       !- Set the values for diffusion scheme
+
+
+       DO ji_nsat=1,n_nsat(jst)
+          ji = index_nsat(ji_nsat,jst)
+
+          ! We only run the scheme in case we are not under mcr with the incoming flux
+          IF (under_mcr(ji).LT.min_sechiba) THEN
+             resolv(ji)=.TRUE.
+             ! In under residual case, we equally spread the transpiration over the layers
+          ELSE
+             under_mcr(ji) = under_mcr(ji) + SUM(rootsink(ji,:,jst))
+          ENDIF
+          !-        First layer
+
+          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))*(dtradia/one_day)/deux - rootsink(ji,1,jst)
+
+          !-	soil body
+          DO jsl=2, nslme(ji,jst)-1
+             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
+       
+          !-        Last layer
+          jsl=nslme(ji,jst)
+          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)) * (dtradia/one_day) / deux & 
+               & - rootsink(ji,jsl,jst)
+
+          !- store the equations in case needed again
+          DO jsl=1,nslm
+             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
+
+       !
+       !- step 4 : solve equations assuming atmosphere limiting
+       !-
+
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+
+
+       !	
+       !- step 5 : check if really atmosphere limiting
+       !-
+       DO ji_nsat=1,n_nsat(jst)
+          ji = index_nsat(ji_nsat,jst)
+
+          resolv(ji) = .FALSE.
+          !
+          !- Prepare to rerun in case of under residual with evaporation or over saturation
+          !-
+          IF(mc(ji,1,jst).LT.(mcr(jst)-min_sechiba).AND.evapot_penm(ji).GT.min_sechiba) THEN
+
+             !- upper layer dry
+             !- We only rerun the scheme in case it is possible to reduce the evaporation
+             resolv(ji) = .TRUE.
+             DO jsl=1,nslm
+                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
+             tmat(ji,1,2) = un
+             tmat(ji,1,3) = zero
+             rhs(ji,1) = mcr(jst)-dmcr    
+             
+          ELSE
+             IF(mc(ji,1,jst).GT.(mcs(jst)+0.02)) THEN
+                
+                !- upper layer saturated
+                resolv(ji) = .TRUE.
+                DO jsl=1,nslm
+                   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
+                tmat(ji,1,2) = un
+                tmat(ji,1,3) = zero
+                rhs(ji,1) = mcs(jst)+dmcs                
+
+             ENDIF
+          ENDIF
+       ENDDO
+
+       !
+       !- step 6 : resolve the equations with new boundary conditions if necessary
+       !-
+
+       CALL hydrol_soil_tridiag(kjpindex,jst)
+
+       !-
+       !- step 6.5 : initialize qflux at bottom of diffusion and avoid over saturated or under residual soil moisture 
+       !-
+
+       DO ji_nsat=1,n_nsat(jst)
+          ji = index_nsat(ji_nsat,jst)
+
+          m_sl0 = mask_return(ji)                  ! the last efficient layer is above the last layer (nslm)
+          
+          !- We add the flux from the last active layer to the first inactive one (not taken into account in the diffusion)
+          !- At the same time, we initialize qflux(ji,jsl,jst) which is useful in case of no returnflow.
+          !- When the first inactive point is to be saturated by the flux, the last efficient begins to fill up and the flux is changed
+          jsl=nslme(ji,jst)
+          qflux(ji,jsl,jst) = (a(ji,jsl)*(w_time*mc(ji,jsl,jst) &
+               &  + (un-w_time)*mcint(ji,jsl)) + b(ji,jsl)) * (dtradia/one_day)
+          
+          mc(ji,jsl+m_sl0,jst) = mc(ji,jsl+m_sl0,jst) + &
+               & m_sl0 * deux * qflux(ji,jsl,jst) / (dz(jsl+m_sl0,jst) + dz(jsl+m_sl0+1,jst))
+          
+          excess = m_sl0 * MAX(mc(ji,jsl+m_sl0,jst)-mcs(jst),zero)
+          mc(ji,jsl+m_sl0,jst) = mc(ji,jsl+m_sl0,jst) - excess
+          
+          DO jsl1 = jsl*m_sl0,1,-1 
+             mc(ji,jsl1,jst) = mc(ji,jsl1,jst) + excess * &
+                  & (dz(jsl1+1,jst) + dz(jsl1+2,jst))/(dz(jsl1,jst) + dz(jsl1+1,jst))
+             excess = MAX(mc(ji,jsl1,jst) - mcs(jst),zero)
+             mc(ji,jsl1,jst) = mc(ji,jsl1,jst) - excess
+          ENDDO
+          
+          ! Smooth the profile to avoid negative values of ponctual soil moisture
+          DO jsl = 1,nslm-1
+             excess = MAX(mcr(jst)-mc(ji,jsl,jst),zero)
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) + excess
+             mc(ji,jsl+1,jst) = mc(ji,jsl+1,jst) - excess * &
+                  &  (dz(jsl,jst)+dz(jsl+1,jst))/(dz(jsl+1,jst)+dz(jsl+2,jst))
+          ENDDO
+          
+          excess = MAX(mcr(jst)-mc(ji,nslm,jst),zero)
+          mc(ji,nslm,jst) = mc(ji,nslm,jst) + excess
+          
+          !- Then if the soil moisture at bottom is not sufficient, we try to refill the column from the top
+          DO jsl = nslm-1,1,-1
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) - excess * &
+                  &  (dz(jsl+1,jst)+dz(jsl+2,jst))/(dz(jsl+1,jst)+dz(jsl,jst))
+             excess = MAX(mcr(jst)-mc(ji,jsl,jst),zero)
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) + excess
+          ENDDO
+          
+          excess = excess * mask_soiltype(ji,jst)
+          mc(ji,:,jst) = mc(ji,:,jst) * mask_soiltype(ji,jst)
+          
+          ! Keep the value in case excess is still positive (due to big change in evapot)
+          under_mcr(ji) = under_mcr(ji) + excess * dz(2,jst)/2                
+          
+          !- We do the opposite thing: in case of over-saturation we put the water where it is possible
+          DO jsl = 1, nslm-1
+             excess = MAX(mc(ji,jsl,jst)-mcs(jst),zero)
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) - excess
+             mc(ji,jsl+1,jst) = mc(ji,jsl+1,jst) + excess * &
+                  &  (dz(jsl,jst)+dz(jsl+1,jst))/(dz(jsl+1,jst)+dz(jsl+2,jst))
+          ENDDO
+ 
+          DO jsl = nslm,2,-1
+             excess = MAX(mc(ji,jsl,jst)-mcs(jst),zero)
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) - excess
+             mc(ji,jsl-1,jst) = mc(ji,jsl-1,jst) + excess * &
+                  &  (dz(jsl,jst)+dz(jsl+1,jst))/(dz(jsl-1,jst)+dz(jsl,jst))
+          ENDDO
+          excess = MAX(mc(ji,1,jst)-mcs(jst),zero)
+          mc(ji,1,jst) = mc(ji,1,jst) - excess
+          
+       ENDDO  ! loop on grid
+
+       ! Finaly, for soil that are under-residual, we just equally distribute the lack of water
+       DO ji_nsat=1,n_nsat(jst)
+          ji = index_nsat(ji_nsat,jst)
+          DO jsl = 1, nslm
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) - under_mcr(ji) / (dpu(jst) * mille)
+          ENDDO
+       ENDDO
+
+       IF (check_cwrr) THEN
+          DO ji_nsat=1,n_nsat(jst)
+             ji = index_nsat(ji_nsat,jst)
+             IF(qflux(ji,nslm,jst)+returnflow_soil(ji).LT.-min_sechiba.AND.soiltype(ji,jst).GT.min_sechiba) THEN
+                WRITE(numout,*)'NEGATIVE FLUX AT LAST EFFICIENT LAYER IN SOIL'
+                WRITE(numout,*)'mc[nlsm]_(t), mc[nslm]_(t-1),jst,soil,ji',&
+                     & mc(ji,nslm,jst),mcint(ji,nslm),jst,soiltype(ji,jst),ji
+                WRITE(numout,*)'irrigation,returnflow,fdc',irrigation_soil(ji),returnflow_soil(ji)
+             ENDIF
+          END DO
+       ENDIF
+       !
+       !- step 7 : close the water balance
+       !
+       !- drainage through the lower boundary
+       !- and fluxes for each soil layer
+       !- with mass balance computed from the bottom to the top 
+       !- of the soil column
+
+       !- Compute the flux at every level from bottom to top (using mc and sink values)
+
+       DO ji_nsat=1,n_nsat(jst)
+          ji = index_nsat(ji_nsat,jst)
+          m_sl0 = mask_return(ji)                  ! the last efficient layer is above the last layer
+
+          DO jsl=nslm-1,nslme(ji,jst),-1
+             qflux(ji,jsl,jst) = qflux(ji,jsl+1,jst) & 
+                  &  + (mc(ji,jsl+1,jst) - mcint(ji,jsl+1)) &
+                  &  * (dz(jsl+1,jst)+dz(jsl+2,jst))/deux &
+                  &  + rootsink(ji,jsl+1,jst) 
+          ENDDO
+
+          jsl = nslme(ji,jst)-1
+          qflux(ji,jsl,jst) = qflux(ji,jsl+1,jst) & 
+               &  + (mc(ji,jsl,jst)-mcint(ji,jsl) &
+               &  + trois*mc(ji,jsl+1,jst) - trois*mcint(ji,jsl+1)) &
+               &  * (dz(jsl+1,jst)/huit) &
+               &  + rootsink(ji,jsl+1,jst) &
+               &  + (dz(jsl+2,jst)/deux) &                    ! zero if nslme=nslm
+               &  * (mc(ji,jsl+1,jst) - mcint(ji,jsl+1))
+
+          DO jsl = nslme(ji,jst)-2,1,-1
+             qflux(ji,jsl,jst) = qflux(ji,jsl+1,jst) & 
+                  &  + (mc(ji,jsl,jst)-mcint(ji,jsl) &
+                  &  + trois*mc(ji,jsl+1,jst) - trois*mcint(ji,jsl+1)) &
+                  &  * (dz(jsl+1,jst)/huit) &
+                  &  + rootsink(ji,jsl+1,jst) &
+                  &  + (dz(jsl+2,jst)/huit) &
+                  &  * (trois*mc(ji,jsl+1,jst) - trois*mcint(ji,jsl+1) &
+                  &  + mc(ji,jsl+2,jst)-mcint(ji,jsl+2)) 
+          END DO
+
+          qflux00(ji,jst) =  qflux(ji,1,jst) + (dz(2,jst)/huit) &
+               &  * (trois* (mc(ji,1,jst)-mcint(ji,1)) + (mc(ji,2,jst)-mcint(ji,2))) &
+               &  + rootsink(ji,1,jst)
+       ENDDO
+
+       !- Then computes the water balance (evap-runoff-drainage)
+
+       DO ji_nsat=1,n_nsat(jst)
+          ji = index_nsat(ji_nsat,jst)
+          !
+          !
+          ! deduction of ae_ns and ru_ns:
+          ! ae_ns+ru_ns=precisol_ns+irrigation-q0  
+          !
+          ae_ns(ji,jst) = MAX(MIN((precisol_ns(ji,jst)+irrigation_soil(ji)-qflux00(ji,jst)),evapot_penm(ji)),zero)
+          ru_ns(ji,jst) = precisol_ns(ji,jst)+irrigation_soil(ji)-qflux00(ji,jst)-ae_ns(ji,jst) !+runoff_excess(ji,jst)
+          !
+          ! In case of negative runoff, we correct it by taking water from the soil
+          ! Le probleme est que desormais, les qflux ne sont plus justes...
+          ! A corriger plus tard...
+          IF (ru_ns(ji,jst).LT.-min_sechiba) THEN
+             WRITE(numout,*) 'Negative runoff corrected', ru_ns(ji,jst), mc(ji,1,jst), SUM(rootsink(ji,:,jst))
+             WRITE(numout,*) 'At...', ji, jst, mask_soiltype(ji,jst), nslme(ji,jst) 
+             excess = -ru_ns(ji,jst)
+             ru_ns(ji,jst) = zero
+             ! We correct this by taking water from the whole soil
+             qflux00(ji,jst) = qflux00(ji,jst) - excess
+             dpue = zz(nslme(ji,jst),jst) + dz(nslme(ji,jst)+1,jst) / deux
+             DO jsl = 1, nslme(ji,jst)
+                mc(ji,jsl,jst) = mc(ji,jsl,jst) - excess / dpue
+             ENDDO
+             ! Then we have to check if there is no negative value 
+
+             DO jsl = 1,nslm-1
+                excess = MAX(mcr(jst)-mc(ji,jsl,jst),zero)
+                mc(ji,jsl,jst) = mc(ji,jsl,jst) + excess
+                mc(ji,jsl+1,jst) = mc(ji,jsl+1,jst) - excess * &
+                     &  (dz(jsl,jst)+dz(jsl+1,jst))/(dz(jsl+1,jst)+dz(jsl+2,jst))
+             ENDDO
+             
+             excess = MAX(mcr(jst)-mc(ji,nslm,jst),zero)
+             mc(ji,nslm,jst) = mc(ji,nslm,jst) + excess
+          
+             !- Then if the soil moisture at bottom is not sufficient, we try to refill the column from the top
+             DO jsl = nslm-1,1,-1
+                mc(ji,jsl,jst) = mc(ji,jsl,jst) - excess * &
+                     &  (dz(jsl+1,jst)+dz(jsl+2,jst))/(dz(jsl+1,jst)+dz(jsl,jst))
+                excess = MAX(mcr(jst)-mc(ji,jsl,jst),zero)
+                mc(ji,jsl,jst) = mc(ji,jsl,jst) + excess
+             ENDDO
+          
+             excess = excess * mask_soiltype(ji,jst)
+             mc(ji,:,jst) = mc(ji,:,jst) * mask_soiltype(ji,jst)
+             
+             ! And if excess is still positive, we put the soil under the residual value:
+             DO jsl = 1, nslm
+                mc(ji,jsl,jst) = mc(ji,jsl,jst) - excess / (dpu(jst) * mille)
+             ENDDO
+          ENDIF
+
+          dr_ns(ji,jst) = qflux(ji,nslm,jst) 
+
+          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
+
+          IF(ABS(dr_ns(ji,jst)).LT.min_sechiba) THEN
+             dr_ns(ji,jst) = zero
+          ENDIF
+
+          ! We add the evaporation to the soil profile
+
+          dpue = zz(nslme(ji,jst),jst) + dz(nslme(ji,jst)+1,jst) / deux
+          DO jsl = 1, nslme(ji,jst)
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) + ae_ns(ji,jst) / dpue
+          ENDDO
+       END DO
+
+       !
+       !- Special case for saturated soil
+       !- We did not use the diffusion and just use a sort of bucket system
+
+       DO ji_nsat=1,n_sat(jst)
+          ji = index_sat(ji_nsat,jst)
+          dr_ns(ji,jst) = zero ! -returnflow_soil(ji)   
+          m_sl0 = mask_soiltype(ji,jst)
+          !
+          !- mc1 and mc2 calculation
+          ! Calculation of mc1 after last timestep evap and after precip and irrigation
+          mc(ji,1,jst) = mc(ji,1,jst) + (precisol_ns(ji,jst) + irrigation_soil(ji) - ae_ns(ji,jst)) &
+               & * 2 / dz(2,jst)
+          ! Preparing to take water from bottom in case of under-residual mc1
+          excess = MAX(mcr(jst)-mc(ji,1,jst),zero)
+          mc(ji,1,jst) = mc(ji,1,jst) + excess
+          ! Calculation of mc2 with returnflow, transpiration and probable lack of water in first layer
+          mc(ji,2,jst) = mc(ji,2,jst) + (returnflow_soil(ji) - tsink(ji) + ae_ns(ji,jst) - & 
+               & excess * dz(2,jst) / 2) * 2/(dz(2,jst) + dz(3,jst))
+          ! Shifting water to top in case of saturation (returnflow very strong)
+          excess = MAX(mc(ji,2,jst)-mcs(jst),zero)
+          mc(ji,2,jst) = mc(ji,2,jst) - excess
+          mc(ji,1,jst) = mc(ji,1,jst) + excess * (dz(2,jst) + dz(3,jst)) / dz(2,jst)
+          ! Avoiding under residual soil moisture for mc2 if transpiration was very high
+          DO jsl = 2, nslm-1
+             excess = MAX(mcr(jst)-mc(ji,jsl,jst),zero)
+             mc(ji,jsl,jst) = mc(ji,jsl,jst) + excess
+             mc(ji,jsl+1,jst) = mc(ji,jsl+1,jst) - excess * &
+                  & (dz(jsl,jst) + dz(jsl+1,jst))/(dz(jsl+1,jst) + dz(jsl+2,jst))
+          ENDDO
+          excess = m_sl0 * excess
+          mc(ji,:,jst) = m_sl0 * mc(ji,:,jst)
+          IF (excess .GT. min_sechiba) THEN
+             STOP 'Saturated soil evaporating everything... Oups...'
+          ENDIF
+          !
+          !- Deduction of ae_ns (used for next step) allowing first two layers drying out
+          ! We first calculate the water that can be evaporated from the first layer and deduce the runoff
+          ae_ns(ji,jst) = m_sl0 * MIN((mc(ji,1,jst)-mcr(jst))*dz(2,jst)/2,evapot_penm(ji)) 
+          ! Generating runoff in case of remaining over saturation in the first layer
+          excess = m_sl0 * MIN(MAX(mc(ji,1,jst)-mcs(jst),zero),mc(ji,1,jst)-mcr(jst)-ae_ns(ji,jst)*2/dz(2,jst))
+          mc(ji,1,jst) = mc(ji,1,jst) - excess
+          ru_ns(ji,jst) = m_sl0 * excess * dz(2,jst)/2
+          ! If it was not sufficient for ae_ns to reach evapot, we evaporate water from the second layer.
+          ae_ns(ji,jst) = ae_ns(ji,jst) + m_sl0 * &
+               & MIN((mc(ji,2,jst)-mcr(jst))*(dz(2,jst)+dz(3,jst))/2, evapot_penm(ji) - ae_ns(ji,jst))
+
+          ! calculation of qflux from what precedes
+          qflux00(ji,jst) = m_sl0 * (precisol_ns(ji,jst) + irrigation_soil(ji) &
+               & - ae_ns(ji,jst) - ru_ns(ji,jst))
+
+          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
+
+
+       !
+       !- step8: 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
+       END DO
+
+       ! the litter is the 4 top levels of the soil
+       ! we 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
+       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(jst))&
+               & /(quatre*(mcs(jst)-mcw(jst))) ))
+          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(jst)) / (quatre*(mcs(jst)-mcw(jst))) ))
+          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(jst))/(quatre*(mcs(jst)-mcw(jst))) ))
+       END DO
+
+       !
+       !- step8: we make the outputs for sechiba:
+       !-we 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
+
+       !- we compute the new humrelv to use in sechiba:
+       !- loop on each vegetation type
+
+       humrelv(:,1,jst) = zero   
+
+       DO jv = 2,nvm
+
+          !- calcul of us for each layer and vegetation type.
+
+          DO ji=1,kjpindex
+             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
+
+          DO jsl = 2,nslm-1
+             DO ji=1,kjpindex
+                us(ji,jv,jst,jsl) =moderwilt(ji,jsl,jst)* &
+                     & MIN( un, &
+                     & ((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(jst)*pcent(jst))) )* &
+                     & (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))
+
+                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
+
+          DO ji=1,kjpindex
+             us(ji,jv,jst,nslm) =moderwilt(ji,nslm,jst)*  &
+                  & MIN(un, &
+                  & ((trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))  &
+                  &                    / (quatre*mcs(jst)*pcent(jst))) ) * &
+                  & (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))
+             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)
+             humrelv(ji,jv,jst) = humrelv(ji,jv,jst) * mask_corr_veg_soil(ji,jv,jst)  
+!             IF(corr_veg_soil(ji,jv,jst).EQ.zero) THEN
+!                humrelv(ji,jv,jst) = zero
+!             ENDIF
+          END DO
+       END DO
+
+       !before closing the soil water, we check the water balance of soil
+
+       IF(check_cwrr) THEN
+          DO ji = 1,kjpindex
+             
+             deltahum = (tmc(ji,jst) - tmcold(ji))
+             diff     = precisol_ns(ji,jst)-ru_ns(ji,jst)-dr_ns(ji,jst)-tsink(ji) + irrigation_soil(ji) + returnflow_soil(ji)
+             
+             IF(abs(deltahum-diff)*mask_soiltype(ji,jst).gt.deux*allowed_err) THEN
+                
+                WRITE(numout,*) 'CWRR pat: bilan non nul',ji,jst,deltahum-diff
+                WRITE(numout,*) 'tmc,tmcold,diff',tmc(ji,jst),tmcold(ji),deltahum
+                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,excess',flux(ji),ru_ns(ji,jst), &
+                     &      dr_ns(ji,jst),tsink(ji),qflux00(ji,jst),precisol_ns(ji,jst),runoff_excess(ji,jst)
+                WRITE(numout,*) 'soiltype',soiltype(ji,jst)
+                WRITE(numout,*) 'irrigation,returnflow',irrigation_soil(ji),returnflow_soil(ji)
+                WRITE(numout,*) 'mc',mc(ji,:,jst)
+                WRITE(numout,*) 'nslme',nslme(ji,jst)
+                WRITE(numout,*) 'qflux',qflux(ji,:,jst)
+                WRITE(numout,*) 'correct,mce',correct_excess(ji),mce(ji)
+                STOP 'in hydrol_soil CWRR water balance check'
+                
+             ENDIF
+             
+             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,ae_ns',evapot(ji),ae_ns(ji,jst)
+                WRITE(numout,*) 'returnflow,irrigation,nslme',returnflow_soil(ji),&
+                     & irrigation_soil(ji),nslme(ji,jst)
+                WRITE(numout,*) 'flux,ru_ns,qdrain,tsink,q0',flux(ji),ru_ns(ji,jst), &
+                     &      dr_ns(ji,jst),tsink(ji),qflux00(ji,jst)
+                WRITE(numout,*) 'soiltype',soiltype(ji,jst)
+                STOP 'in hydrol_soil CWRR MC NEGATIVE'
+             ENDIF
+          END DO
+
+          DO ji_nsat=1,n_nsat(jst)
+             ji = index_nsat(ji_nsat,jst)
+             IF (ru_ns(ji,jst).LT.-min_sechiba) THEN
+                WRITE(numout,*) 'Negative runoff in non-saturated case', ji,jst, mask_soiltype(ji,jst) 
+                WRITE(numout,*) 'mc1, mc2, nslme', mc(ji,1,jst), mc(ji,2,jst), nslme(ji,jst)
+                WRITE(numout,*) 'mcint1, mcint2, mce', mcint(ji,1), mcint(ji,2), mce(ji)
+                WRITE(numout,*) 'qflux1, correct, flux', qflux(ji,nslm,jst), correct_excess(ji), flux(ji)
+                WRITE(numout,*) 'under_mcr, test', 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, precisol_ns, irrigation, qflux0, ru_ns', &
+                     & ae_ns(ji,jst), tsink(ji), returnflow_soil(ji), &
+                     & precisol_ns(ji,jst), irrigation_soil(ji), qflux00(ji,jst), ru_ns(ji,jst)
+                STOP 'STOP in hydrol_soil: Negative runoff, non-saturated soil'
+             ENDIF
+          ENDDO
+
+          DO ji_nsat=1,n_sat(jst)
+             ji = index_sat(ji_nsat,jst)
+             m_sl0 = mask_soiltype(ji,jst)
+             IF (ru_ns(ji,jst).LT.-min_sechiba) THEN
+                WRITE(numout,*) 'Negative runoff in saturated case', ji,jst, mask_soiltype(ji,jst), &
+                     & mc(ji,1,jst), mc(ji,2,jst), ae_ns(ji,jst), tsink(ji), returnflow_soil(ji), &
+                     & precisol_ns(ji,jst), irrigation_soil(ji), qflux00(ji,jst), ru_ns(ji,jst)
+                STOP 'STOP in hydrol_soil: Negative runoff, saturated soil'
+             ENDIF
+          ENDDO
+       ENDIF
+
+    END DO  ! end of loop on soiltype
+
+    !
+    ! sum 3d variables into 2d variables
+    !
+    CALL hydrol_diag_soil (kjpindex, veget, veget_max, soiltype, runoff, drainage, &
+         & evap_bare_lim, evapot, vevapnu, returnflow, irrigation, &
+         & shumdiag, litterhumdiag, humrel, vegstress, drysoil_frac,tot_melt)
+    RETURN
+
+  END SUBROUTINE hydrol_soil
+
+  SUBROUTINE hydrol_soil_tridiag(kjpindex,ins)
+
+    !- solves a set of linear equations which has  a tridiagonal
+    !-  coefficient matrix.
+
+    !- arguments
+    INTEGER(i_std), INTENT(in)                         :: kjpindex        !! Domain size
+    INTEGER(i_std), INTENT(in)                         :: ins             !! number of soil type
+
+    !  -- variables locales
+
+    INTEGER(i_std)                      ::  ji,jt,jsl,ji_nsat
+    REAL(r_std), DIMENSION(kjpindex)                             :: bet
+
+    DO ji_nsat = 1,n_nsat(ins)
+       ji = index_nsat(ji_nsat,ins)
+
+       IF (resolv(ji)) THEN
+          bet(ji) = tmat(ji,1,2)
+          mc(ji,1,ins) = rhs(ji,1)/bet(ji)
+
+          DO jsl = 2,nslme(ji,ins)
+             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)
+          ENDDO
+
+          DO jsl = nslme(ji,ins)-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_setup(kjpindex,ins,dtradia)
+
+    !
+    !**** *hydrol_soil_setup* - 
+    !**** *routine that computes the matrix coef for dublin model.
+    !**** *uses the linearised hydraulic conductivity k_lin=a_lin mc_lin+b_lin
+    !**** *and the linearised diffusivity d_lin
+    !
+    IMPLICIT NONE
+    !
+    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
+    ! local 
+    INTEGER(i_std) :: jsl,ji,i,m_sl0,m_sl1, ji_nsat
+    REAL(r_std), DIMENSION (nslm)      :: temp0, temp5, temp6, temp7
+    REAL(r_std)                        :: temp3, temp4
+
+    !-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
+
+    DO jsl=1,nslm
+       DO ji=1,kjpindex 
+          i= MIN(INT((imax-imin)*(MAX(mc(ji,jsl,ins),mcr(ins))-mcr(ins))&
+               &         / (mcs(ins)-mcr(ins)))+imin , imax-1)
+          a(ji,jsl) = a_lin(i,ins)
+          b(ji,jsl) = b_lin(i,ins)
+          d(ji,jsl) = d_lin(i,ins)
+       ENDDO ! loop on grid
+    ENDDO
+    
+
+    !-second, 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
+
+    temp3 = w_time*(dtradia/one_day)/deux
+    temp4 = (un-w_time)*(dtradia/one_day)/deux
+
+    DO ji_nsat=1,n_nsat(ins)
+       ji = index_nsat(ji_nsat,ins)
+
+       !- First layer temporary calc
+       !- Be careful! The order (first layer before last) is very important in case nslme(ji,jst)=1
+       temp0(1) = trois * dz(2,ins)/huit
+       temp5(1) = zero
+       temp6(1) = (d(ji,1)+d(ji,2))/(dz(2,ins)) + a(ji,1)
+       temp7(1) = (d(ji,1)+d(ji,2))/(dz(2,ins)) - a(ji,2)
+
+       !- Main body
+       DO jsl = 2, nslme(ji,ins)-1
+          temp0(jsl) = trois *  (dz(jsl,ins) + dz(jsl+1,ins))/huit 
+          temp5(jsl) =(d(ji,jsl)+d(ji,jsl-1))/(dz(jsl,ins))+a(ji,jsl-1)
+          temp6(jsl) = (d(ji,jsl)+d(ji,jsl-1))/(dz(jsl,ins)) + &
+               & (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1,ins))
+          temp7(jsl) = (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1,ins)) &
+               & - a(ji,jsl+1) 
+       ENDDO
+
+       !- Last layer
+       jsl = nslme(ji,ins)
+       temp0(jsl) = trois * (dz(jsl,ins) + dz(jsl+1,ins))/huit &
+            & + dz(jsl+1,ins)/huit
+       temp5(jsl) = (d(ji,jsl)+d(ji,jsl-1)) / (dz(jsl,ins)) &
+            & + a(ji,jsl-1)
+       temp6(jsl) = (d(ji,jsl)+d(ji,jsl-1))/dz(jsl,ins) & 
+            & + a(ji,jsl) 
+       temp7(jsl) = zero
+
+       !- coefficient for every layer
+       DO jsl = 1, nslme(ji,ins)
+          e(ji,jsl) = dz(jsl,ins)/(huit)    - temp3*temp5(jsl) 
+          f(ji,jsl) = temp0(jsl)       + temp3*temp6(jsl)
+          g1(ji,jsl) = dz(jsl+1,ins)/(huit)  - temp3*temp7(jsl)
+          ep(ji,jsl) = dz(jsl,ins)/(huit)   + temp4*temp5(jsl) 
+          fp(ji,jsl) = temp0(jsl)      - temp4*temp6(jsl)  
+          gp(ji,jsl) = dz(jsl+1,ins)/(huit) + temp4*temp7(jsl)
+       ENDDO
+    ENDDO
+
+    RETURN
+  END SUBROUTINE hydrol_soil_setup
+
+  !!! fait la connexion entre l'hydrologie et sechiba :
+  !!! cherche les variables sechiba pour l'hydrologie
+  !!! "transforme" ces variables
+  SUBROUTINE hydrol_split_soil (kjpindex, veget, soiltype, vevapnu, transpir, humrel,evap_bare_lim)
+    ! 
+    ! interface description
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex
+    REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in)       :: veget            !! Vegetation map 
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltype         !! Map of soil types
+    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   !!   
+    !
+    ! local declaration
+    !
+    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
+
+    !
+    !
+    ! split 2d variables into 3d variables, per soil type
+    !
+    precisol_ns(:,:)=zero
+    DO jv=1,nvm
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF(veget(ji,jv).GT.min_sechiba) THEN
+                precisol_ns(ji,jst)=precisol_ns(ji,jst)+precisol(ji,jv)* &
+                     & corr_veg_soil(ji,jv,jst) / veget(ji,jv)
+             ENDIF
+          END DO
+       END DO
+    END DO
+    !
+    !
+    !
+    vevapnu_old(:)=zero
+    DO jst=1,nstm
+       DO ji=1,kjpindex
+          vevapnu_old(ji)=vevapnu_old(ji)+ &
+               & ae_ns(ji,jst)*soiltype(ji,jst)*vegtot(ji)
+       END DO
+    END DO
+    !
+    !
+    !
+    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
+                ae_ns(ji,jst)=ae_ns(ji,jst) * vevapnu(ji)/vevapnu_old(ji)
+             ENDIF
+          ELSEIF(veget(ji,1).GT.min_sechiba.AND.soiltype(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
+                ae_ns(ji,jst)=vevapnu(ji)*corr_veg_soil(ji,1,jst)/veget(ji,1)
+             ENDIF
+          ENDIF
+          precisol_ns(ji,jst)=precisol_ns(ji,jst)+MAX(-ae_ns(ji,jst),zero)
+       END DO
+    END DO
+
+    tr_ns(:,:)=zero
+    DO jv=1,nvm
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             IF (corr_veg_soil(ji,jv,jst).GT.min_sechiba.AND.humrel(ji,jv).GT.min_sechiba) THEN 
+                tr_ns(ji,jst)=tr_ns(ji,jst)+ corr_veg_soil(ji,jv,jst)*humrelv(ji,jv,jst)* & 
+                     & transpir(ji,jv)/(humrel(ji,jv)*veget(ji,jv))
+             ENDIF
+          END DO
+       END DO
+    END DO
+
+    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).AND.(corr_veg_soil(ji,jv,jst).GT.min_sechiba)) THEN 
+                   rootsink(ji,jsl,jst) = rootsink(ji,jsl,jst) &
+                        & + corr_veg_soil(ji,jv,jst)* (transpir(ji,jv)*us(ji,jv,jst,jsl))/ &
+                        & (humrel(ji,jv)*veget(ji,jv))
+                END IF
+             END DO
+          END DO
+       END DO
+    END DO
+
+    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',veget(ji,:)
+                   WRITE(numout,*) 'humrel',humrel(ji,:)
+                   WRITE(numout,*) 'humrelv (pour ce jst)',humrelv(ji,:,jst)
+                   WRITE(numout,*) 'ae_ns',ae_ns(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
+
+
+    ! Now we check if the deconvolution is correct and conserves the fluxes:
+
+    IF (check_cwrr) THEN
+
+
+       tmp_check1(:)=zero
+       tmp_check2(:)=zero  
+
+       ! First we check 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))* &
+                  & soiltype(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,*) 'vegtot',vegtot(ji)
+
+             DO jv=1,nvm
+                WRITE(numout,*) 'jv,veget, precisol',jv,veget(ji,jv),precisol(ji,jv)
+                DO jst=1,nstm
+                   WRITE(numout,*) 'corr_veg_soil:jst',jst,corr_veg_soil(ji,jv,jst)
+                END DO
+             END DO
+
+             DO jst=1,nstm
+                WRITE(numout,*) 'jst,precisol_ns',jst,precisol_ns(ji,jst)
+                WRITE(numout,*) 'soiltype', soiltype(ji,jst)
+             END DO
+             STOP 'in hydrol_split_soil check_cwrr'
+          ENDIF
+
+       END DO
+
+
+       tmp_check1(:)=zero
+       tmp_check2(:)=zero 
+
+       DO jst=1,nstm
+          DO ji=1,kjpindex
+             tmp_check1(ji)=tmp_check1(ji) + ae_ns(ji,jst)* &
+                  & soiltype(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,*) 'vegtot',vegtot(ji)
+             WRITE(numout,*) 'evap_bare_lim, evap_bare_lim_ns',evap_bare_lim(ji), evap_bare_lim_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,*) 'soiltype', soiltype(ji,jst)
+             END DO
+             STOP 'in hydrol_split_soil check_cwrr'
+          ENDIF
+       ENDDO
+
+       ! Second we check 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)* &
+                  & soiltype(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,*) 'vegtot',vegtot(ji)
+
+             DO jv=1,nvm
+                WRITE(numout,*) 'jv,veget, transpir',jv,veget(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,*) 'soiltype', soiltype(ji,jst)
+             END DO
+
+             STOP 'in hydrol_split_soil check_cwrr'
+          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,*) '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
+                STOP 'in hydrol_split_soil check_cwrr'
+             ENDIF
+          END DO
+       END DO
+
+    ENDIF
+
+    RETURN 
+
+  END SUBROUTINE hydrol_split_soil
+
+  SUBROUTINE hydrol_diag_soil (kjpindex, veget, veget_max,soiltype, runoff, drainage, &
+       & evap_bare_lim, evapot, vevapnu, returnflow, irrigation, &
+       & shumdiag, litterhumdiag, humrel, vegstress, drysoil_frac, tot_melt)
+    ! 
+    ! interface description
+    ! input scalar 
+    INTEGER(i_std), INTENT(in)                               :: kjpindex 
+    REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in)       :: veget           !! Map of vegetation types
+    REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)        :: veget_max       !! Max. vegetation type
+    REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in)      :: soiltype        !! Map of soil types
+    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), INTENT(out)           :: evap_bare_lim   !! 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: evapot          !! 
+    REAL(r_std), DIMENSION (kjpindex), INTENT(inout)         :: vevapnu  
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: returnflow       !! Water returning to the deep reservoir
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: irrigation      !! Water from irrigation
+    REAL(r_std), DIMENSION (kjpindex), INTENT(in)            :: tot_melt
+    REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out)      :: shumdiag        !! relative soil moisture
+    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)
+    !
+    ! local declaration
+    !
+    INTEGER(i_std)                                :: ji, jv, jsl, jst
+    REAL(r_std), DIMENSION (kjpindex)                                    :: mask_vegtot
+    !
+    ! Put the prognostics variables of soil to zero if soiltype is zero
+
+    DO jst=1,nstm 
+
+       DO ji=1,kjpindex
+
+!          IF(soiltype(ji,jst).EQ.zero) THEN
+
+             ae_ns(ji,jst) = ae_ns(ji,jst) * mask_soiltype(ji,jst)
+             dr_ns(ji,jst) = dr_ns(ji,jst) * mask_soiltype(ji,jst)
+             ru_ns(ji,jst) = ru_ns(ji,jst) * mask_soiltype(ji,jst)
+             tmc(ji,jst) =  tmc(ji,jst) * mask_soiltype(ji,jst)
+
+             DO jv=1,nvm
+                humrelv(ji,jv,jst) = humrelv(ji,jv,jst) * mask_soiltype(ji,jst)
+                DO jsl=1,nslm
+                   us(ji,jv,jst,jsl) = us(ji,jv,jst,jsl)  * mask_soiltype(ji,jst)
+                END DO
+             END DO
+
+             DO jsl=1,nslm          
+                mc(ji,jsl,jst) = mc(ji,jsl,jst)  * mask_soiltype(ji,jst)
+             END DO
+
+!          ENDIF
+
+       END DO
+    END DO
+
+
+    runoff(:) = zero
+    drainage(:) = zero
+    humtot(:) = zero
+    evap_bare_lim(:) = zero
+    evap_bare_lim_ns(:,:) = zero
+    shumdiag(:,:)= zero
+    litterhumdiag(:) = zero
+    tmc_litt_mea(:) = zero
+    soilmoist(:,:) = zero
+    humrel(:,:) = zero
+    vegstress(:,:) = zero
+    !
+    ! sum 3d variables in 2d variables with fraction of vegetation per soil type
+    !
+
+
+    DO ji = 1, kjpindex
+!         WRITE(numout,*) ' kjpindex',kjpindex,ji,vegtot(ji)
+!        mask_vegtot = MIN( un, MAX(zero,vegtot(ji) ) )
+          mask_vegtot(ji) = 0
+          IF(vegtot(ji) .GT. min_sechiba) THEN
+           mask_vegtot(ji) = 1
+          ENDIF
+     END DO           
+
+      DO ji = 1, kjpindex 
+!        WRITE(numout,*) 'vegtot,mask_vegtot',ji,vegtot(ji),mask_vegtot(ji)
+        ae_ns(ji,:) = mask_vegtot(ji) * ae_ns(ji,:)  * corr_veg_soil(ji,1,:)
+           DO jst = 1, nstm
+             drainage(ji) = mask_vegtot(ji) * (drainage(ji) + vegtot(ji)*soiltype(ji,jst) * dr_ns(ji,jst))
+             runoff(ji) = mask_vegtot(ji) *  (runoff(ji) +   vegtot(ji)*soiltype(ji,jst) * ru_ns(ji,jst)) &
+                  & + (1 - mask_vegtot(ji)) * (tot_melt(ji) + irrigation(ji) + returnflow(ji))
+             humtot(ji) = mask_vegtot(ji) * (humtot(ji) + soiltype(ji,jst) * tmc(ji,jst))
+           END DO
+    END DO
+
+    DO jst=1,nstm
+       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) = ae_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) * ae_ns(ji,jst) / evapot(ji)
+          END IF
+
+       END DO
+    END DO
+
+     DO ji = 1, kjpindex
+         evap_bare_lim(ji) =   SUM(evap_bare_lim_ns(ji,:)*vegtot(ji)*soiltype(ji,:))
+        IF(evap_bare_lim(ji).GT.un + min_sechiba) THEN
+           WRITE(numout,*) 'CWRR DIAG EVAP_BARE_LIM TOO LARGE', ji, &
+                & evap_bare_lim(ji),evap_bare_lim_ns(ji,:)
+        ENDIF 
+        !print *,'HYDROL_DIAG: ji,evap_bare_lim,evap_bare_lim_ns',ji,evap_bare_lim(ji),evap_bare_lim_ns(ji,:)
+     ENDDO
+    ! 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)*soiltype(ji,jst) &
+                & * corr_veg_soil_max(ji,jv,jst) *vegtot(ji)/veget_max(ji,jv)
+             vegstress(ji,jv)= MAX(vegstress(ji,jv),zero)
+             ENDIF
+
+             IF(veget(ji,jv).GT.min_sechiba) THEN
+                humrel(ji,jv)=humrel(ji,jv)+humrelv(ji,jv,jst)*soiltype(ji,jst) &
+                     & * corr_veg_soil(ji,jv,jst)*vegtot(ji)/veget(ji,jv)
+                humrel(ji,jv)=MAX(humrel(ji,jv),zero)
+             ENDIF
+          END DO
+       END DO
+    END DO
+
+!    vegstress(:,:) =  humrel(:,:)
+
+
+    DO jst=1,nstm        
+
+       DO ji=1,kjpindex
+          litterhumdiag(ji) = litterhumdiag(ji) + &
+               & soil_wet_litter(ji,jst) * soiltype(ji,jst)
+
+          tmc_litt_mea(ji) = tmc_litt_mea(ji) + &
+               & tmc_litter(ji,jst) * soiltype(ji,jst) 
+
+       END DO
+
+
+       DO jsl=1,nbdl
+          DO ji=1,kjpindex
+             shumdiag(ji,jsl)= shumdiag(ji,jsl) + soil_wet(ji,jsl,jst) * &
+                  & ((mcs(jst)-mcw(jst))/(mcf(jst)-mcw(jst))) * &
+                  & soiltype(ji,jst)
+             soilmoist(ji,jsl)=soilmoist(ji,jsl)+mc(ji,jsl,jst)*soiltype(ji,jst)
+             shumdiag(ji,jsl) = MAX(MIN(shumdiag(ji,jsl), un), zero) 
+          END DO
+       END DO
+
+
+    END DO
+
+
+    DO ji=1,kjpindex
+       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)
+    END DO
+
+
+
+
+
+  END SUBROUTINE hydrol_diag_soil
+
+  !!
+  !! This routines 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
+  !!
+  SUBROUTINE hydrol_waterbal (kjpindex, index, first_call, dtradia, veget, totfrac_nobio, &
+       & qsintveg, snow,snow_nobio, precip_rain, precip_snow, returnflow, irrigation, tot_melt, &
+       & vevapwet, transpir, vevapnu, vevapsno, runoff, drainage)
+    !
+    !
+    !
+    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        !! 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 from irrigation
+    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)       :: runoff       !! complete runoff
+    REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: drainage     !! Drainage
+    !
+    !  LOCAL
+    !
+    INTEGER(i_std) :: ji
+    REAL(r_std) :: watveg, delta_water, tot_flux
+    !
+    !
+    !
+    IF ( first_call ) THEN
+
+       tot_water_beg(:) = zero
+
+       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(:)
+
+
+       RETURN
+
+    ENDIF
+    !
+    !  Check the water balance
+    !
+    tot_water_end(:) = 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)
+          STOP 'in hydrol_waterbal'
+       ENDIF
+       !
+       watveg = SUM(qsintveg(ji,:))
+       tot_water_end(ji) = humtot(ji)*vegtot(ji) + watveg + &
+            & snow(ji) + SUM(snow_nobio(ji,:))
+       !
+       delta_water = tot_water_end(ji) - tot_water_beg(ji)
+       !
+       tot_flux =  precip_rain(ji) + precip_snow(ji) + irrigation (ji) - &
+            & SUM(vevapwet(ji,:)) - SUM(transpir(ji,:)) - vevapnu(ji) - vevapsno(ji) - &
+            & runoff(ji) - drainage(ji) + returnflow(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) .GT. deux*allowed_err ) THEN
+          WRITE(numout,*) '------------------------------------------------------------------------- '
+          WRITE(numout,*) 'HYDROL does not conserve water. The erroneous point is : ', ji
+          WRITE(numout,*) 'The error in mm/s is :', (delta_water-tot_flux)/dtradia, ' and in mm/dt : ', delta_water-tot_flux
+          WRITE(numout,*) 'delta_water : ', delta_water, ' tot_flux : ', tot_flux
+          WRITE(numout,*) 'Actual and allowed error : ', ABS(delta_water-tot_flux), 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 : ', returnflow(ji),irrigation(ji)
+          WRITE(numout,*) 'Total water in soil :',  humtot(ji)
+          WRITE(numout,*) 'Water on vegetation :', watveg
+          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 : ', vevapnu(ji), vevapsno(ji)
+          WRITE(numout,*) 'drainage,runoff : ', drainage(ji),runoff(ji)
+          STOP 'in 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
+    !
+  END SUBROUTINE hydrol_waterbal
+  !
+  !  This routine computes the changes in soil moisture and interception storage for the ALMA outputs
+  !
+  SUBROUTINE hydrol_alma (kjpindex, index, first_call, qsintveg, snow, snow_nobio, soilwet)
+    !
+    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), INTENT (out)      :: soilwet     !! Soil wetness
+    REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio     !! Water balance on ice, lakes, .. [Kg/m^2]
+    !
+    !  LOCAL
+    !
+    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
+       soilwet(ji) = tot_watsoil_end(ji) / mx_eau_var(ji)
+    ENDDO
+    !
+  END SUBROUTINE hydrol_alma
+  !
+  !
+END MODULE hydrol
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/hydrolc.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/hydrolc.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/hydrolc.f90	(revision 854)
@@ -0,0 +1,3391 @@
+! =================================================================================================================================
+! 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 parametrization. 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 the 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 parametrization. The upper layer has a variable depth
+!! and can disappear after dry spells (Ducoudre 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)     : 
+!!  - Ducoudre, 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-Ducoudre, 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/
+!!  - Ducoudre, N. (1990). Sensibilite du climat simule a la parametrisation des echanges de vapeur 
+!! d'eau entre la biosphere et l'atmosphere. These de Doctorat, Universite 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, Universite Paris 6. 
+!!  - de Rosnay, P. (1999). Representation des interactions sol-plante-atmosphere dans le modele de 
+!! circulation generale du LMD. These de doctorat, Universite Paris 6. 
+!!  - Guimberteau, M, 2010. Modelisation de l'hydrologie continentale et influences de l'irrigation 
+!! sur le cycle de l'eau, hese de doctorat, Universite Paris 6. 
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+ 
+MODULE hydrolc
+  
+  
+  USE ioipsl
+  
+  ! modules used :
+  USE constantes        ! contains technical constants
+  USE constantes_soil   ! soil properties and geometry (underground)
+  USE constantes_veg    ! surface and vegetation properties
+  USE sechiba_io        ! for inpout/output
+  USE grid              ! for grid, masks and calendar
+  USE parallel          ! for all parallel modules
+!  USE Write_Field_p
+
+  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)
+  !
+  LOGICAL, SAVE                            :: check_waterbal=.FALSE. !! To check the water balance (true/false)
+  LOGICAL, SAVE                                   :: ok_hdiff        !! To do horizontal diffusion between soil columns
+                                                                     !! (true/false)
+
+  CHARACTER(LEN=80) , SAVE                        :: var_name        !! To store variables names for I/O
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: bqsb            !! Water content in the bottom layer  
+                                                                     !! @tex ($kg m^{-2}$) @endtex 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: gqsb            !! Water content in the top layer @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dsg             !! Depth of the top layer (m) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dsp             !! Depth of dry soil in the bottom layer plus depth of top 
+                                                                     !! layer (m)
+  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
+  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 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_water_beg   !! Total amount of water at start of time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: tot_water_end   !! Total amount of water at end of time step  
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+  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
+  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
+  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
+  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
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: snow_beg        !! Total snow water equivalent at start of time step  
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: snow_end        !! Total snow water equivalent at end of time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: delsoilmoist    !! Change in soil moisture during time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: delintercept    !! Change in interception storage during time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: delswe          !! Change in snow water equivalent during time step 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dss             !! Depth of dry soil at the top, whether in the top or bottom 
+                                                                     !! layer (m) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: hdry            !! Mean top dry soil height (m) version beton
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: precisol        !! Throughfall @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: subsnowveg      !! Sublimation of snow on vegetation 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: subsnownobio    !! Sublimation of snow on other surface types (ice, lakes,...)
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: snowmelt        !! Snow melt @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: icemelt         !! Ice melt @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: gdrainage       !! Drainage between the two soil layers 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: vegtot          !! Total fraction of grid-cell covered by PFTs (bare soil + 
+                                                                     !! vegetation) (0-1, unitless)
+  
+  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 
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: mx_eau_var      !! Maximum water content of the soil 
+                                                                     !! @tex ($kg m^{-2}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: ruu_ch          !! Volumetric soil water capacity @tex ($kg m^{-3}$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: runoff          !! Total runoff @tex ($kg m^{-2}$) @endtex
+
+  REAL(r_std), PARAMETER                          :: dsg_min = 0.001 !! Reference depth to define subgrid variability of saturated
+                                                                     !! top soil layer (m) 
+!_ ================================================================================================================================                                                                     
+! version beton ; NdN et FH, 28 mars 2006
+
+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 three 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)
+!!  - call 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 is controlled by two flags : 
+!! - almaoutput defines the nature/name of the written variables, whether following the 
+!! ALMA norm or not
+!! - hist2_id : if positive, then a subsample of the above variables is also output to 
+!! second ncdf file. *** I don't get the role of hist2_id
+!! 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). ! *** but with a unit error. 
+!!
+!! We consider that any water on the ice 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 NOTICE : 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, &
+     & temp_sol_new, run_off_tot, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+     & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, tot_melt, transpir, &
+     & precip_rain, precip_snow, returnflow, irrigation, humrel, vegstress, rsol, drysoil_frac, evapot, evapot_corr,&
+     & 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)
+                                                                                !! More info needed
+    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)
+    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)           :: 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
+    
+    !! 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)        :: 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,nbdl), INTENT (inout)   :: 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)          :: 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)        :: 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 
+    
+    !! 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
+!_ ================================================================================================================================
+    
+  !! 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, irrigation, tot_melt, vevapwet, transpir, vevapnu, vevapsno,&
+                & 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. 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 '
+
+        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 computes snow
+    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  computes 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)
+   
+    !! 3.c computes hydro_soil
+    CALL hydrolc_soil(kjpindex, vevapnu, precisol, returnflow, 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, irrigation, tot_melt, vevapwet, transpir, vevapnu, vevapsno,&
+            & 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(hist_id, 'dss', kjit, dss, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'bqsb', kjit, mean_bqsb, kjpindex, index)
+       CALL histwrite(hist_id, 'gqsb', kjit, mean_gqsb, kjpindex, index)
+       CALL histwrite(hist_id, 'runoff', kjit, run_off_tot, kjpindex, index) ! this is surface runoff = 5% of total runoff
+       CALL histwrite(hist_id, 'drainage', kjit, drainage, kjpindex, index) ! this 95% of total runoff
+       CALL histwrite(hist_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'rain', kjit, precip_rain, kjpindex, index)
+       CALL histwrite(hist_id, 'snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite(hist_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+       CALL histwrite(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
+                histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*mx_eau_eau, zero)
+             ENDIF
+          ENDDO
+       ENDDO
+       ! *** I'm not sure what it is AD180112
+       CALL histwrite(hist_id, 'mrsos', kjit, histvar, kjpindex, index) 
+
+       ! this is total soil moisture
+       histvar(:)=mean_bqsb(:)+mean_gqsb(:)
+       CALL histwrite(hist_id, 'mrso', kjit, histvar, kjpindex, index) 
+
+       ! *** the division by one_day is not consistent with the above hiswrite, e.g. for drainage
+       ! this is surface runoff = 5% of total runoff
+       histvar(:)=run_off_tot(:)/one_day 
+       CALL histwrite(hist_id, 'mrros', kjit, histvar, kjpindex, index) 
+
+       ! *** the division by one_day is not consistent with the above hiswrite, e.g. for drainage
+       ! this is total runoff
+       histvar(:)=(run_off_tot(:)+drainage(:))/one_day 
+       CALL histwrite(hist_id, 'mrro', kjit, histvar, kjpindex, index) 
+
+       ! *** the division by one_day is not consistent with the above hiswrite, e.g. for drainage
+       histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))/one_day 
+       CALL histwrite(hist_id, 'prveg', kjit, histvar, kjpindex, index)
+
+    ELSE 
+       
+       ! almaoutput=true
+       CALL histwrite(hist_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+       CALL histwrite(hist_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+   
+       ! surface runoff = 5% of total runoff
+       CALL histwrite(hist_id, 'Qs', kjit, run_off_tot, kjpindex, index)
+
+       ! drainage = 95% of total runoff
+       CALL histwrite(hist_id, 'Qsb', kjit, drainage, kjpindex, index) 
+       CALL histwrite(hist_id, 'Qsm', kjit, tot_melt, kjpindex, index)
+       CALL histwrite(hist_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+       CALL histwrite(hist_id, 'DelSWE', kjit, delswe, kjpindex, index)
+       CALL histwrite(hist_id, 'DelIntercept', kjit, delintercept, kjpindex, index)      
+       CALL histwrite(hist_id, 'SoilMoist', kjit, tot_watsoil_end, kjpindex, index)
+       CALL histwrite(hist_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+       
+       ! this the transpiration stress factor
+       CALL histwrite(hist_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg) 
+       
+       CALL histwrite(hist_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+       CALL histwrite(hist_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+       CALL histwrite(hist_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
+       
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite(hist2_id, 'dss', kjit, dss, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'bqsb', kjit, mean_bqsb, kjpindex, index)
+          CALL histwrite(hist2_id, 'gqsb', kjit, mean_gqsb, kjpindex, index)
+          CALL histwrite(hist2_id, 'runoff', kjit, run_off_tot, kjpindex, index)
+          CALL histwrite(hist2_id, 'drainage', kjit, drainage, kjpindex, index)
+          CALL histwrite(hist2_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'rain', kjit, precip_rain, kjpindex, index)
+          CALL histwrite(hist2_id, 'snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite(hist2_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'humrel',   kjit, humrel,   kjpindex*nvm, indexveg)
+          
+        !! If "hist2_id > 0", we also have a unit issue with mrro and mrros for "CMIP5", which are 48 times too small !***
+          histvar(:)=zero
+          DO jv = 1, nvm
+             DO ji = 1, kjpindex
+                IF ( vegtot(ji) .GT. zero ) THEN
+                   histvar(ji)=histvar(ji)+veget(ji,jv)/vegtot(ji)*MAX((0.1-dss(ji,jv))*mx_eau_eau, zero)
+                ENDIF
+             ENDDO
+          ENDDO
+          CALL histwrite(hist2_id, 'mrsos', kjit, histvar, kjpindex, index)
+
+          histvar(:)=(run_off_tot(:)+drainage(:))/one_day
+          CALL histwrite(hist2_id, 'mrro', kjit, histvar, kjpindex, index)
+
+       ELSE
+          CALL histwrite(hist2_id, 'Snowf', kjit, precip_snow, kjpindex, index)
+          CALL histwrite(hist2_id, 'Rainf', kjit, precip_rain, kjpindex, index)
+          CALL histwrite(hist2_id, 'Qs', kjit, run_off_tot, kjpindex, index)
+          CALL histwrite(hist2_id, 'Qsb', kjit, drainage, kjpindex, index)
+          CALL histwrite(hist2_id, 'Qsm', kjit, tot_melt, kjpindex, index)
+          CALL histwrite(hist2_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
+          CALL histwrite(hist2_id, 'DelSWE', kjit, delswe, kjpindex, index)
+          CALL histwrite(hist2_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
+          
+          CALL histwrite(hist2_id, 'SoilMoist', kjit, tot_watsoil_end, kjpindex, index)
+          CALL histwrite(hist2_id, 'SoilWet', kjit, soilwet, kjpindex, index)
+          
+          CALL histwrite(hist2_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
+          CALL histwrite(hist2_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
+          
+          CALL histwrite(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)
+    REAL(r_std), ALLOCATABLE, DIMENSION (:,:)            :: zdsp_g              !! Ancillary variables for initializing dsp and 
+                                                                                !! 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)
+!_ ================================================================================================================================
+
+  !! 1. Make sure initialization happens only once
+    
+    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  Def  = n
+    !Config  Help = If TRUE, then water can diffuse horizontally between
+    !Config         the PFTs' water reservoirs.
+ 
+    ok_hdiff = .FALSE.
+    CALL getin_p('HYDROL_OK_HDIFF',ok_hdiff) 
+
+  !! 3. Make dynamic allocation with good dimension
+
+    ! 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
+
+    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
+
+    !! 4.a 0pen restart input file done by sechiba_init
+    !! and read data from restart input file 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('UNITS', 'kg/m^2')
+        CALL ioconf_setatt('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('UNITS', 'd')
+        CALL ioconf_setatt('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('UNITS', 'kg/m^2')
+        CALL ioconf_setatt('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('UNITS', 'd')
+        CALL ioconf_setatt('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('UNITS', '-')
+        CALL ioconf_setatt('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('UNITS', '-')
+        CALL ioconf_setatt('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('UNITS', 'kg/m^2')
+        CALL ioconf_setatt('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('UNITS', 'kg/m^2')
+        CALL ioconf_setatt('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('UNITS', 'm')
+        CALL ioconf_setatt('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('UNITS', 'm')
+        CALL ioconf_setatt('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('UNITS', 'm')
+        CALL ioconf_setatt('LONG_NAME','Hauteur au dessus du reservoir de surface')
+        IF ( ok_var(var_name) ) THEN
+           CALL restget_p (rest_id, var_name, nbp_glo, nvm  , 1, kjit, .TRUE., dss, "gather", nbp_glo, index_g)
+        ENDIF
+        
+        var_name= 'hdry'
+        CALL ioconf_setatt('UNITS', 'm')
+        CALL ioconf_setatt('LONG_NAME','Dry soil heigth in meters')
+        IF ( ok_var(var_name) ) THEN
+           CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., hdry, "gather", nbp_glo, index_g)
+        ENDIF
+        
+        var_name= 'qsintveg'
+        CALL ioconf_setatt('UNITS', 'kg/m^2')
+        CALL ioconf_setatt('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('UNITS', '-')
+        CALL ioconf_setatt('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 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.  
+        CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero)
+        
+        !Config Key  = HYDROL_SNOWAGE
+        !Config Desc = Initial snow age if not found in restart
+        !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.
+        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 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.
+        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 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.
+        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 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.
+        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 Def  = DEF
+        !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.
+        CALL setvar_p (bqsb, val_exp, 'HYDROL_BQSB', mx_eau_eau*dpu_cste)
+        
+        !Config Key  = HYDROL_GQSB
+        !Config Desc = Initial upper soil moisture if not found in restart
+        !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.
+        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 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.
+        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 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. 
+        CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero)
+        
+        !! 4.c Specific calculations are required 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 Def  = DEF
+        !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.
+        zdsp(:,:) = dpu_cste - bqsb(:,:) / mx_eau_eau ! we compute the depth of top layer from bqsb
+        dsp(1,1) = val_exp ! 999999.
+        call getin_p('HYDROL_DSP', dsp(1,1))
+        IF (dsp(1,1) == val_exp) THEN
+           dsp(:,:) = zdsp(:,:)
+        ELSE
+           IF (is_root_prc) &
+                ALLOCATE(zdsp_g(nbp_glo,nvm),dsp_g(nbp_glo,nvm))
+           CALL gather(zdsp,zdsp_g)
+           IF (is_root_prc) &
+                CALL setvar (dsp_g, val_exp, 'HYDROL_DSP', zdsp_g)
+           CALL scatter(dsp_g,dsp)
+           IF (is_root_prc) &
+                DEALLOCATE(zdsp_g, dsp_g)
+        ENDIF
+                
+        ! set inital value for dss 
+        tmpdss = dsg - gqsb / mx_eau_eau
+        IF ( ok_var("dss") ) THEN
+           CALL setvar_p (dss, val_exp, 'NO_KEYWORD', tmpdss)
+        ELSE
+           dss(:,:)=tmpdss(:,:)
+        ENDIF
+                
+        ! set inital value for hdry , see hydrolc_soil, step 8.4
+        IF ( ok_var("hdry") ) THEN
+           IF (MINVAL(hdry) .EQ. MAXVAL(hdry) .AND. MAXVAL(hdry) .EQ. 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) + (1.-a_subgrd(:))*dsp(:,1)
+           ENDIF
+        ELSE
+           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 = veget
+        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,:))
+        ENDDO
+        
+    ENDIF ! IF (ldrestart_read)
+    
+  !! 5. 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. 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_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
+    
+    tmp_dl(1) = 0
+    tmp_dl(2:nbdl+1) = diaglev(1:nbdl)
+    
+  !! 2. Calculation of mx_eau_var and ruu_ch 
+     
+    mx_eau_var(:) = zero
+    
+    DO ji = 1,kjpindex
+      DO jv = 1,nvm
+         
+         ! wmax_veg is mx_eau_eau for each PFT *** REDUNDANCY ???
+         mx_eau_var(ji) = mx_eau_var(ji) + veget(ji,jv)*wmax_veg(jv)*dpu_cste 
+      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_eau*dpu_cste 
+      ENDIF
+      ruu_ch(ji) = mx_eau_var(ji) / dpu_cste
+    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 (mean relative soil moisture in the different diagnostic levels, for use by thermosoil.f90)
+    !!     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 (dry when dss = 0.1 m)
+  !!     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 (veget(ji,1) .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_cste - drysoil_frac(ji))+1.e-10)**2 ) * rsol_cste
+          rsol(ji) =  ( hdry(ji) + un/(10.*(dpu_cste - 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.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 (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_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)\n
+!! This subroutine deals with changes in veget.
+!!
+!! The vegetation cover has changed and we need to adapt the reservoir distribution.
+!! 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 $\le$ veget_max\n
+!!  - for the bare soil PFT (iv=1), veget holds the fraction of bare soil, from all 
+!! PFTs : veget(:,1) $\ge$ veget_max(:,1)\n
+!! 
+!! This subroutine aims at adapting the distribution of water among the different liquid water reservoirs 
+!! (interception reservoir and soil moisture) when after 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 ?)
+!!
+!! 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
+        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
+        
+  !! 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
+
+         !  Water on vegetation (in kg m^{-2}) redistributed using previous "veget"
+         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. Calculate the total water mass that we have to redistribute by grid-point
+
+    !  Calculate the total water mass that we have 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. We put the water to redistribute from the PFTs that "shrank" into the reservoirs of 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 
+              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
+              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_cste - bqsb(ji,jv) / ruu_ch(ji)
+        ENDIF
+      ENDDO
+    ENDDO
+
+  !! 7. We update resdist for the next "veget" change
+    
+    DO jv = 1, 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_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 fraction of bare soil (including the bare soil 
+!! fractions over the vegetation PFTs). 
+!!  - 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 
+    LOGICAL, SAVE                                        :: firstcall=.TRUE.   !! Flag for first time step (true/false) 
+                                                                               !! ! *** why not use l_first_hydrol ?
+    REAL(r_std), SAVE, DIMENSION(nvm)                    :: throughfall_by_pft !! Fraction of rainfall that cannot be intercepted 
+                                                                               !! and falls to the ground, defined by PFT (0-1, 
+                                                                               !! unitless) 
+!_ ================================================================================================================================
+
+  !! 1. At first time step, assign $throughfall\_by\_pft$ (fraction of rainfall that cannot be intercepted in ech each PFT)
+    
+    IF ( firstcall ) THEN
+       !Config  Key  = PERCENT_THROUGHFALL_PFT
+       !Config  Desc = Percent by PFT of precip that is not intercepted by the canopy
+       !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.
+       
+       throughfall_by_pft = (/ 30., 30., 30., 30., 30., 30., 30., 30., 30., 30., 30., 30., 30. /)
+       CALL getin_p('PERCENT_THROUGHFALL_PFT',throughfall_by_pft)
+       throughfall_by_pft = throughfall_by_pft / 100.
+
+       firstcall=.FALSE.
+    ENDIF
+
+    ! 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
+    !   
+    ! (a). evaporation off the continents
+    !
+    ! (b). The interception loss is withdrawn from the canopy interception reservoir
+    ! This requires that vevapwet is consistent with qsintveg (in diffuco)
+    DO jv=1,nvm
+      qsintveg(:,jv) = qsintveg(:,jv) - vevapwet(:,jv)
+    END DO
+
+  !! 2. It is raining : loading of the canopy interception reservoir 
+
+    ! - Uniform loading of rainfall in each PFT up to the interception capacity qsintmax, which depends on the PFT
+    ! - But a fraction of the rain always falls to the ground (throughfall_by_pft)
+    ! - 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(:)
+      qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * ((1-throughfall_by_pft(jv))*precip_rain(:))
+    END DO
+    
+    !! 2.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)
+        precisol(ji,jv) = (veget(ji,jv)*throughfall_by_pft(jv)*precip_rain(ji)) + qsintveg(ji,jv ) - zqsintvegnew (ji,jv)
+      ENDDO
+    ENDDO
+    
+    !! 2.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_soil
+!!
+!>\BRIEF           This routines computes the soil water budget and the related soil water 
+!! fluxes and soil moisture diagnostics. 
+!!
+!! DESCRIPTION     : 
+!! 1. Main processes:
+!! The Choisnel parametrization relies on two soil layers. The upper one has a variable depth 
+!! and can disappear after dry spells. It is created by rainfall, in which case the layer is 
+!! saturated, and if this top layer is already present, rainfall can either fill it or make it 
+!! deeper (DucoudrÃ© et al., 1993). 
+!! The main prognostic and diagnostic variables appear in the following figure, apart from 
+!! runoff which only occurs when the entire soil column is saturated.
+!! \latexonly
+!! \includegraphics[scale = 0.7]{choisnelvariables.pdf}
+!! \endlatexonly
+!!
+!! In this framework, most water fluxes updating soil moisture act from the top:
+!!  - 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.
+!! Irrigation (de Rosnay et al., 2003) and return flow are optional inflows, calculated by the 
+!! routing scheme (Ngo-Duc et al., 2005; Guimberteau, 2010).
+!!
+!! Soil moisture stress on bare soil evaporation, 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.
+!!
+!! Some configurations of the top layer can be deadlock situations for the Choisnel scheme 
+!! and need to be handled :
+!!  - if the top layer is almost dry, we merge the two layers 
+!!  - if the top layer is very deep, we drain some water from the top to the bottom layer
+!! Drainage is allowed between the two layers, but not at the bottom. This drainage flux 
+!! non-linearly depends on the top layer moisture (Ducharne et al., 1998). 
+!! 
+!! Runoff is only 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).
+!!
+!! 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.
+!! 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) :
+!!  - Ducoudre, 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/
+!!  - Ducoudre, N. (1990). Sensibilite du climat simule a la parametrisation des echanges de vapeur d'eau entre 
+!! la biosphere et l'atmosphere. These de Doctorat, Universite 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, Universite Paris 6.
+!!  - de Rosnay, P. (1999). Representation des interactions sol-plante-atmosphere dans le modele de circulation generale
+!! du LMD. These de doctorat, Universite Paris 6.
+!!  - Guimberteau, M, 2010. Modelisation de l'hydrologie continentale et influences de l'irrigation sur le cycle de l'eau, 
+!! These de doctorat, Universite Paris 6.
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+    
+
+  SUBROUTINE hydrolc_soil(kjpindex, vevapnu, precisol, returnflow, 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)       :: 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
+        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
+      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. (veget(ji,1) .GT. min_sechiba) ) THEN
+        zeflux(ji,1) = vevapnu(ji)/veget(ji,1)
+      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). ! *** ?
+    DO jv = 1, nvm
+      DO ji = 1, kjpindex
+        IF ( (vegtot(ji) .GT. zero) .AND. (veget(ji,1) .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. Update 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)
+        
+        IF(vegtot(ji) .NE. zero) THEN
+
+           ! Snow and ice melt and troughfall from vegetation
+           gqsb(ji,jv) = gqsb(ji,jv) + zpreci(ji,jv) + tot_melt(ji)/vegtot(ji)
+           
+           ! We take care to add the irrigation only to the vegetated part if possible
+           IF (ABS(vegtot(ji)-veget(ji,1)) .LE. min_sechiba) THEN !  if there is vegetation
+              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)-veget(ji,1))
+                 ELSE
+                    bqsb(ji,jv) = bqsb(ji,jv) + irrigation(ji)/(vegtot(ji)-veget(ji,1))
+                 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 (when runoff is generated): no top layer; dss = dsp (dry depth in bottom layer)
+        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 If the soil is not saturated and the top layer holds more water than allowed by its depth:
+            !! the top layer deepens; it 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 neither the soil nor the top layer is saturated : its total depth does not change
+            !! and we only need to 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: this layers 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_cste - 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_cste
+            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 that hold a tiny amount of water
+ 
+    !!  Top layers that are very large or that hold a tiny amount of water
+    !! can be deadlock situations for the Choisnel scheme. 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_resdis ) THEN ! min_resdis = 2.e-5 (constantes_soil.f90)
+            bqsb(ji,jv) = bqsb(ji,jv) + gqsb(ji,jv)
+            dsp(ji,jv) = dpu_cste - 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 If the top layer is not almost dry 
+        !!   If the top layer is not almost dry, we drain some water from the top to the bottom layer,
+        !!   following Ducharne et al., 1998. This internal drainage is highly non-linear, and 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
+        !!   \latexonly
+        !!   \input{gdrainage.tex}
+        !!   \endlatexonly
+        gqseuil = min_resdis * deux * ruu_ch(ji) ! min_resdis = 2.e-5 (constantes_soil.f90)
+        eausup = dsg(ji,jv) * ruu_ch(ji)
+        wd1 = .75*eausup
+        
+        IF (eausup .GT. gqseuil) THEN ! dsg > 4.e-5 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_cste - 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
+    
+    !! We want the vegetation to share a common bottom moisture, which is the grid-cell weighted average.
+    !!\latexonly
+    !!\input{bdiff.tex}
+    !!\endlatexonly
+    !!\n
+    !! 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
+          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
+      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
+              IF ( veget(ji,jv) .GT. zero ) THEN
+                 !
+                 bqsb(ji,jv) = mean_bqsb(ji)
+                 dsp(ji,jv) = dpu_cste - bqsb(ji,jv)/ruu_ch(ji) ! *** can this line make dsp>dpu_cste ?
+              ENDIF
+           ENDIF
+           
+        ENDDO
+      ENDDO    
+      
+      !! 6.3 We have a problem if the top layer
+      !! We have a problem if the top layer, when present, is larger than the 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
+      lbad(:,:) = ( ( dsp(:,:) .LT. dsg(:,:) ) .AND. &
+                    ( dsg(:,:) .GT. zero ) .AND. &
+                    ( veget(:,:) .GT. zero ) )
+      
+      !! 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
+        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_cste - 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
+            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
+        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
+       DO jv = 1, 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) !  *** do we really allow for irrigation if there is no soil/veget ???
+      ENDIF
+    ENDDO
+    
+    !! 7.2 Estimate some drainage, thus surface runoff
+    !!\latexonly
+    !!\input{drs.tex}
+    !!\endlatexonly
+    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
+    !! 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
+
+         IF ( gqsb(ji,jv)+bqsb(ji,jv) .GT. zero ) THEN ! total soil moisture is positive
+            
+            IF (dsg(ji,jv).EQ. zero .OR. gqsb(ji,jv).EQ.zero) THEN 
+
+               !! 8.1.1 If no top soil layer, the top dry soil depth is dsp, and vegstress=humrel
+               !!\latexonly
+               !!\input{humrel1.tex}
+               !!\endlatexonly
+               humrel(ji,jv) = EXP( - humcste(jv) * dpu_cste * (dsp(ji,jv)/dpu_cste) ) ! *** we could simplify by dpu_cste 
+               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_cste - (qwilt / ruu_ch(ji))) .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, 
+               !! If there are two soil layers, we compute humrel as the average of the values defined by the two dry soil
+               !! depths dss and dsp:
+               !! \latexonly
+               !! \input{humrel2.tex}
+               !! \endlatexonly
+	       !! The weights depend on "a_subgrd", which defines the "transpiring" fraction of the 
+               !! top soil layer. It 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 level 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 We need to estimate the fraction of visibly dry soil in the bare soil fraction 
+    !!  if we want to account for the effet of soil moisture on soil albedo 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. 
+    !!  \latexonly
+    !!  \input{rsol.tex}
+    !!  \endlatexonly
+    !!  \n   
+    !!  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 *** Figure
+    !!  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 (veget(ji,1) .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_cste - 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 following sentence is not consistent with what I understand from the code, since snow_nobio is accounted for.
+!! "The computation is only done over the soil area, as over glaciers (and lakes?) we do not have 
+!! water conservation. "
+!! *** 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, irrigation, tot_melt, vevapwet, transpir, vevapnu, vevapsno, 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)          :: 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)          :: vevapsno       !! Snow evaporation @tex ($kg m^{-2}$) @endtex
+    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
+    !!   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) + irrigation(ji) - &
+             & sum_vevapwet(ji) - sum_transpir(ji) - vevapnu(ji) - vevapsno(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 : ', 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 : ', vevapnu(ji), vevapsno(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:
+!! the changes in water amounts over the time steps (in 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 top 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 top soil layer's moisture.
+!!
+!! For three variables (the top and bottom soil moistures, and dss, the depth of dry soil at the top, 
+!! whether in the top or bottom layer), we describe a linear relaxation of the values within each soil column 
+!! towards their grid-cell average, with a timescale of one day *** Eq to insert
+!!
+!! 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) 
+    LOGICAL, SAVE                                        :: firstcall=.TRUE. !! Flag to set tau_hdiff at the first time step 
+                                                                             !! ! *** why not define this parameter in 
+                                                                             !! constantes_soil.f90 ?
+!_ ================================================================================================================================
+
+  !! 1. At the first time step, we assign a value to the time scale for horizontal water diffusion (s) 
+    
+    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.
+      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. 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
+        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)
+      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 values towards mean
+   
+    !! Relax values towards mean : the diffusion is proportional to the deviation to the mean,
+    !!  and inversely proportional to the timescale tau_hdiff.
+    !!  \latexonly
+    !!  \input{hdiff.tex}
+    !!  \endlatexonly
+    !!  \n
+    !!  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_cste - bqsb(ji,jv) / ruu_ch(ji) ! no change here since bqsb does not change
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE hydrolc_hdiff
+  
+END MODULE hydrolc
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/intersurf.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/intersurf.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/intersurf.f90	(revision 854)
@@ -0,0 +1,5593 @@
+
+!! 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 defprec
+  USE sechiba
+  USE constantes
+  USE constantes_soil
+  USE constantes_veg
+  USE parallel
+  USE watchout
+  USE solar
+  USE grid
+!    USE Write_Field_p
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC :: intersurf_main, stom_define_history, stom_IPCC_define_history, intsurf_time
+
+  INTERFACE intersurf_main
+    MODULE PROCEDURE intersurf_main_2d, intersurf_main_1d, intersurf_gathered, intersurf_gathered_2m
+  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
+  !
+  INTEGER(i_std), SAVE                               :: hist_id, rest_id        !! IDs for history and restart files
+  INTEGER(i_std), SAVE                               :: hist2_id                !! ID for the second history files (Hi-frequency ?)
+  INTEGER(i_std), SAVE                               :: hist_id_stom, hist_id_stom_IPCC, rest_id_stom !! Dito for STOMATE
+  REAL(r_std), SAVE                                  :: dw                      !! frequency of history write (sec.)
+  !
+  INTEGER(i_std), SAVE                               :: itau_offset  !! This offset is used to phase the 
+  !                                                                 !! calendar of the GCM or the driver.
+  REAL(r_std)                                        :: date0_shifted
+  !
+  TYPE(control_type), SAVE                          :: control_flags !! Flags that (de)activate parts of the model
+  !
+  !
+  !! first day of this year
+  REAL(r_std) :: julian0
+  !
+  LOGICAL, PARAMETER :: check_INPUTS = .FALSE.         !! (very) long print of INPUTs in intersurf 
+  LOGICAL, SAVE :: OFF_LINE_MODE = .FALSE. 
+  LOGICAL, SAVE :: check_time = .FALSE.
+  PUBLIC check_time, l_first_intersurf
+  !
+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) 
+    
+    ! 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)             :: 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
+    ! 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)                      :: 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
+    !
+    ! Local variables with shape of the inputs
+    !
+    REAL(r_std),DIMENSION (iim,jjm)                       :: dswnet         !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (iim,jjm)                       :: dswdown         !! Incident surface short-wave flux
+    !
+    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 Init_WriteField_p(kindex)
+       !
+       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(lon,lon_g)
+       CALL gather2D(lat,lat_g)
+       CALL gather2D(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)
+       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
+       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)
+       IF ( control_flags%ok_stomate ) THEN
+          CALL histwrite(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          IF ( hist_id_stom_IPCC > 0 ) THEN
+             CALL histwrite(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          ENDIF
+       ENDIF
+       CALL histwrite(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+       CALL histsync(hist_id)
+       !
+       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, 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 ) 
+    
+    !
+    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 
+    dswnet(:,:)       = undef_sechiba 
+    dswdown(:,:)      = 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)/1000.
+       riverflow(i,j)    = zriver(ik)/1000.
+       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)
+       dswnet(i,j)       = zswnet(ik)
+       dswdown(i,j)      = zswdown(ik)
+
+    ENDDO
+    !
+    ! Modified fields for variables scattered during the writing
+    !
+    dcoastal(:) = (zcoastal(:))/1000.     
+    driver(:)   = (zriver(:))/1000.
+    !
+    IF ( .NOT. l_first_intersurf) THEN
+       !
+       IF ( .NOT. almaoutput ) THEN
+       !
+       !  scattered during the writing
+       !
+          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, temp_sol_NEW, kjpindex, kindex)
+          CALL histwrite (hist_id, 'tsol_max', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
+          CALL histwrite (hist_id, 'tsol_min', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
+          CALL histwrite (hist_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex)
+          CALL histwrite (hist_id, 'fluxlat',  itau_sechiba, fluxlat, kjpindex, kindex)
+          CALL histwrite (hist_id, 'swnet',    itau_sechiba, dswnet, kjpindex, kindex)
+          CALL histwrite (hist_id, 'swdown',   itau_sechiba, dswdown, kjpindex, kindex)
+          CALL histwrite (hist_id, 'alb_vis',  itau_sechiba, albedo(:,:,1), kjpindex, kindex)
+          CALL histwrite (hist_id, 'alb_nir',  itau_sechiba, albedo(:,:,2), kjpindex, kindex)
+          CALL histwrite (hist_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+          CALL histwrite (hist_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+          ! Ajout Nathalie - Juin 2006 - on conserve q2m/t2m
+          CALL histwrite (hist_id, 'q2m',     itau_sechiba, qair, kjpindex, kindex)
+          CALL histwrite (hist_id, 't2m',     itau_sechiba, temp_air, kjpindex, kindex)
+          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, temp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'fluxlat',  itau_sechiba, fluxlat, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'swnet',    itau_sechiba, dswnet, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'swdown',   itau_sechiba, dswdown, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'alb_vis',  itau_sechiba, albedo(:,:,1), kjpindex, kindex)
+             CALL histwrite (hist2_id, 'alb_nir',  itau_sechiba, albedo(:,:,2), kjpindex, kindex)
+             CALL histwrite (hist2_id, 'tair',     itau_sechiba, temp_air, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'qair',     itau_sechiba, qair, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'q2m',     itau_sechiba, qair, kjpindex, kindex)
+             CALL histwrite (hist2_id, 't2m',     itau_sechiba, temp_air, kjpindex, kindex)
+          ENDIF
+       ELSE
+          CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+          CALL histwrite (hist_id, 'SWnet',    itau_sechiba, dswnet, kjpindex, kindex)
+          CALL histwrite (hist_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex)
+          CALL histwrite (hist_id, 'Qle',  itau_sechiba, fluxlat, kjpindex, kindex)
+          CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
+          CALL histwrite (hist_id, 'RadT', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'SWnet',    itau_sechiba, dswnet, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'Qle',  itau_sechiba, fluxlat, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'RadT', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
+          ENDIF
+       ENDIF
+       !
+       IF (dw .EQ. xrdt) 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
+    !
+    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) 
+    
+    ! 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)             :: 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
+    ! 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)                      :: 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
+    !
+    ! Local but with input shape
+    !
+    REAL(r_std),DIMENSION (iim*jjm)                       :: dswnet         !! Net surface short-wave flux
+    REAL(r_std),DIMENSION (iim*jjm)                       :: dswdown        !! Incident surface short-wave flux
+    !
+    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))
+       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
+       !
+       CALL histwrite(hist_id, 'LandPoints',  itau_sechiba+1, (/ REAL(kindex) /), kjpindex, kindex)
+       CALL histwrite(hist_id, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       IF ( control_flags%ok_stomate ) THEN
+          CALL histwrite(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          IF ( hist_id_stom_IPCC > 0 ) THEN
+             CALL histwrite(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          ENDIF
+       ENDIF
+       CALL histwrite(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+       CALL histsync(hist_id)
+       !
+       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, 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 ) 
+    
+    !
+    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 
+    dswnet(:)       = undef_sechiba 
+    dswdown(:)      = undef_sechiba 
+    !
+    DO ik=1, kjpindex
+       
+       z0(kindex(ik))           = zz0(ik)
+       coastalflow(kindex(ik))  = zcoastal(ik)/1000.
+       riverflow(kindex(ik))    = zriver(ik)/1000.
+       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)
+       dswnet(kindex(ik))       = zswnet(ik)
+       dswdown(kindex(ik))      = zswdown(ik)
+
+    ENDDO
+    !
+    ! Modified fields for variables scattered during the writing
+    !
+    dcoastal(:) = (zcoastal(:))/1000.
+    driver(:)   = (zriver(:))/1000.
+    !
+    IF ( .NOT. l_first_intersurf) THEN
+       !
+       IF ( .NOT. almaoutput ) THEN
+          !
+          !  scattered during the writing
+          !
+          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, temp_sol_NEW, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'tsol_max', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'tsol_min', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'fluxsens', itau_sechiba, fluxsens, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'fluxlat',  itau_sechiba, fluxlat, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'swnet',    itau_sechiba, dswnet, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'swdown',   itau_sechiba, dswdown, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'alb_vis',  itau_sechiba, albedo(:,1), iim*jjm, kindex)
+          CALL histwrite (hist_id, 'alb_nir',  itau_sechiba, albedo(:,2), iim*jjm, kindex)
+          CALL histwrite (hist_id, 'tair',     itau_sechiba, temp_air, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'qair',     itau_sechiba, qair, iim*jjm, kindex)
+          ! Ajouts Nathalie - Juin 2006 - sauvegarde de t2m et q2m
+          CALL histwrite (hist_id, 'q2m',     itau_sechiba, qair, iim*jjm, kindex)
+          CALL histwrite (hist_id, 't2m',     itau_sechiba, temp_air, iim*jjm, kindex)
+          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, temp_sol_NEW, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, fluxsens, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'fluxlat',  itau_sechiba, fluxlat, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'swnet',    itau_sechiba, dswnet, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'swdown',   itau_sechiba, dswdown, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'alb_vis',  itau_sechiba, albedo(:,1), iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'alb_nir',  itau_sechiba, albedo(:,2), iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'tair',     itau_sechiba, temp_air, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'qair',     itau_sechiba, qair, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'q2m',     itau_sechiba, qair, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 't2m',     itau_sechiba, temp_air, iim*jjm, kindex)
+          ENDIF
+       ELSE
+          CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+          CALL histwrite (hist_id, 'SWnet',    itau_sechiba, dswnet, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'Qh', itau_sechiba, fluxsens, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'Qle',  itau_sechiba, fluxlat, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'RadT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'SWnet',    itau_sechiba, dswnet, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'Qh', itau_sechiba, fluxsens, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'Qle',  itau_sechiba, fluxlat, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'RadT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
+          ENDIF
+       ENDIF
+       !
+       IF (dw .EQ. xrdt) 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
+!
+!-------------------------------------------------------------------------------------
+!
+#ifdef CPP_PARA
+  SUBROUTINE intersurf_gathered (kjit, iim_glo, jjm_glo, offset, kjpindex, kindex, communicator, 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) 
+#else
+  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) 
+#endif
+    ! 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_glo, jjm_glo  !! Dimension of global fields
+#ifdef CPP_PARA
+    INTEGER(i_std),INTENT (in)                            :: offset        !! offset between the first global 2D point 
+                                                                           !! and the first local 2D point.
+    INTEGER(i_std),INTENT(IN)                             :: communicator  !! Orchidee communicator
+#endif
+    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
+    ! 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
+    ! 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
+    !
+    ! Optional arguments
+    !
+    REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN), OPTIONAL :: 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.
+    !
+    ! Scattered variables for diagnostics
+    !
+!    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dvevapp       !! Diagnostic array for evaporation
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dtemp_sol     !! for surface temperature
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dfluxsens     !! for sensible heat flux
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dfluxlat      !! for latent heat flux
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dswnet        !! net solar radiation
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dswdown       !! Incident solar radiation
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:,:)                     :: dalbedo       !! albedo
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dtair         !! air temperature
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dqair         !! specific air humidity
+    !
+    !
+    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 = .FALSE.
+    INTEGER(i_std),DIMENSION (kjpindex)                  :: kindex_p
+    !
+    LOGICAL, SAVE                                         :: fatmco2       !! Flag to force the value of atmospheric CO2 for vegetation.
+    REAL(r_std), SAVE                                     :: atmco2        !! atmospheric CO2 
+    !
+    CALL ipslnlf(old_number=old_fileout)
+    !
+    IF (l_first_intersurf) THEN
+       !
+       CALL intsurf_time( kjit, date0, xrdt )
+       !
+       IF ( check ) WRITE(numout,*) 'Initialisation of intersurf'
+       !
+       CALL ioget_calendar (one_year, one_day)
+       !
+#ifdef CPP_PARA
+       CALL init_para(.TRUE.,communicator)
+       kindex_p(:)=kindex(:) + offset
+#else
+       CALL init_para(.FALSE.)
+       kindex_p(:)=kindex(:)
+#endif
+       CALL ipslnlf(new_number=numout)
+       !
+       CALL init_data_para(iim_glo,jjm_glo,kjpindex,kindex_p)
+       iim=iim_glo
+       jjm=jj_nb
+       ALLOCATE(lon_scat(iim,jjm))
+       ALLOCATE(lat_scat(iim,jjm))
+!       ALLOCATE(dvevapp(iim*jjm))
+       ALLOCATE(dtemp_sol(iim*jjm))
+       ALLOCATE(dfluxsens(iim*jjm))
+       ALLOCATE(dfluxlat(iim*jjm))
+       ALLOCATE(dswnet(iim*jjm))
+       ALLOCATE(dswdown(iim*jjm))
+       ALLOCATE(dalbedo(iim*jjm,2))
+       ALLOCATE(dtair(iim*jjm))
+       ALLOCATE(dqair(iim*jjm))
+       
+!       CALL init_WriteField_p(kindex)
+       !
+       ! 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 ( PRESENT(lon_scat_g) .AND. PRESENT(lat_scat_g)) THEN
+          
+          lon_scat(:,:)=zero
+          lat_scat(:,:)=zero 
+          CALL scatter2D(lon_scat_g,lon_scat)
+          CALL scatter2D(lat_scat_g,lat_scat)
+          lon_scat(:,1)=lon_scat(:,2)
+          lon_scat(:,jj_nb)=lon_scat(:,2)
+          lat_scat(:,1)=lat_scat(iim,1)
+          lat_scat(:,jj_nb)=lat_scat(1,jj_nb)
+          
+          tmp_lon(:,:) = lon_scat(:,:)
+          tmp_lat(:,:) = lat_scat(:,:)
+
+          IF (is_root_prc) THEN
+             lon_g(:,:) = lon_scat_g(:,:)
+             lat_g(:,:) = lat_scat_g(:,:)
+          ENDIF
+
+       ELSE IF ( PRESENT(lon_scat_g) .OR. PRESENT(lat_scat_g)) THEN
+
+          WRITE(numout,*) 'You need to provide the longitude AND latitude on the'
+          WRITE(numout,*) 'gathered grid in order to start ORCHIDEE.'
+          STOP 'intersurf_gathered'
+
+       ELSE
+          !
+          WRITE(numout,*) 'intersurf_gathered : We try to guess to full grid of the model.' 
+          WRITE(numout,*) 'I might fail, please report if it does. '
+          !
+          tmp_lon(:,:) = val_exp
+          tmp_lat(:,:) = val_exp
+          !
+          DO ik=1, kjpindex
+             j = INT( (kindex(ik)-1) / iim ) + 1
+             i = kindex(ik) - (j-1) * iim
+             tmp_lon(i,j) = lalo(ik,2)
+             tmp_lat(i,j) = lalo(ik,1)
+          ENDDO
+          !
+          ! Here we fill out the grid. To do this we do the strong hypothesis
+          ! that the grid is regular. Will this work in all cases ????
+          !
+          DO i=1,iim
+             mx = MAXVAL(tmp_lon(i,:), MASK=tmp_lon(i,:) .LT. val_exp)
+             IF ( mx .LT. val_exp ) THEN
+                tmp_lon(i,:) = mx
+             ELSE
+                WRITE(numout,*) 'Could not find a continental point on this longitude. Thus the grid'
+                WRITE(numout,*) 'could not be completed.'
+                STOP 'intersurf_gathered'
+             ENDIF
+          ENDDO
+          !
+          DO j=1,jjm
+             mx = MAXVAL(tmp_lat(:,j), MASK=tmp_lat(:,j) .LT. val_exp)
+             IF ( mx .LT. val_exp ) THEN
+                tmp_lat(:,j) = mx
+             ELSE
+                WRITE(numout,*) 'Could not find a continental point on this latitude. Thus the grid'
+                WRITE(numout,*) 'could not be completed.'
+                STOP 'intersurf_gathered'
+             ENDIF
+          ENDDO
+
+          CALL gather2D(tmp_lon,lon_g)
+          CALL gather2D(tmp_lat,lat_g)
+
+       ENDIF
+       !
+       DO ik=1, kjpindex
+          j = INT( (kindex(ik)-1) / iim ) + 1
+          i = kindex(ik) - (j-1) * iim
+          tmp_lev(i,j) = zlev(ik)
+       ENDDO
+       CALL gather2D(tmp_lev,zlev_g)
+       !
+       !
+       !  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)
+       !
+       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
+
+          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
+    !
+    CALL ipslnlf(new_number=numout)
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    !
+    CALL intsurf_time( itau_sechiba, date0_shifted, xrdt )
+    !
+    ! 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,*) "Index for continental points = ",kindex
+       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
+       WRITE(numout,*) "Geographical coordinates lon = ", lon_scat
+       WRITE(numout,*) "Geographical coordinates lat = ", lat_scat 
+       WRITE(numout,*) "Fraction of continent in the grid = ",zcontfrac
+    ENDIF
+    !
+    ! 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
+       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)
+       IF ( control_flags%ok_stomate ) THEN
+            CALL histwrite(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          IF ( hist_id_stom_IPCC > 0 ) THEN
+             CALL histwrite(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          ENDIF
+       ENDIF
+       CALL histwrite(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+       CALL histsync(hist_id)
+       !
+       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
+    !
+    ! 4. 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
+!       & 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, 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 ) 
+    
+    !
+    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
+    !    
+!    dvevapp(:)    = undef_sechiba
+    dtemp_sol(:)  = undef_sechiba
+    dfluxsens(:)  = undef_sechiba
+    dfluxlat(:)   = undef_sechiba
+    dswnet (:)    = undef_sechiba
+    dswdown (:)   = undef_sechiba
+    dalbedo (:,1) = undef_sechiba
+    dalbedo (:,2) = undef_sechiba
+    dtair (:)     = undef_sechiba
+    dqair (:)     = undef_sechiba
+    !
+    DO ik=1, kjpindex
+       
+       z0(ik)           = zz0(ik)
+       coastalflow(ik)  = zcoastal(ik)/1000.
+       riverflow(ik)    = zriver(ik)/1000.
+       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)
+       
+       ! Fill up the diagnostic arrays
+
+!       dvevapp(kindex(ik))    = zvevapp(ik)
+       dtemp_sol(kindex(ik))  = ztemp_sol_new(ik)
+       dfluxsens(kindex(ik))  = zfluxsens(ik)
+       dfluxlat(kindex(ik))   = zfluxlat(ik)
+       dswnet (kindex(ik))    = swnet(ik)
+       dswdown (kindex(ik))   = swdown(ik)
+       dalbedo (kindex(ik),1) = zalbedo(ik,1)
+       dalbedo (kindex(ik),2) = zalbedo(ik,2)   
+       dtair (kindex(ik))     = temp_air(ik)
+       dqair (kindex(ik))     = qair(ik)
+       !
+    ENDDO
+    !
+    ! Modified fields for variables scattered during the writing
+    !
+    dcoastal(:) = (zcoastal(:))/1000.
+    driver(:)   = (zriver(:))/1000.
+    !
+    IF ( .NOT. l_first_intersurf) THEN
+       !
+       IF ( .NOT. almaoutput ) THEN
+          !
+          !  scattered during the writing
+          !           
+          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, dtemp_sol, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'tsol_max', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'tsol_min', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'fluxsens', itau_sechiba, dfluxsens, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'fluxlat',  itau_sechiba, dfluxlat,  iim*jjm, kindex)
+          CALL histwrite (hist_id, 'swnet',    itau_sechiba, dswnet,    iim*jjm, kindex)
+          CALL histwrite (hist_id, 'swdown',   itau_sechiba, dswdown,   iim*jjm, kindex)
+          CALL histwrite (hist_id, 'alb_vis',  itau_sechiba, dalbedo(:,1), iim*jjm, kindex)
+          CALL histwrite (hist_id, 'alb_nir',  itau_sechiba, dalbedo(:,2), iim*jjm, kindex)
+          CALL histwrite (hist_id, 'tair',     itau_sechiba, dtair, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'qair',     itau_sechiba, dqair, iim*jjm, kindex)
+          CALL histwrite (hist_id, 't2m',      itau_sechiba, dtair, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'q2m',      itau_sechiba, dqair, iim*jjm, kindex)
+          !
+          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, dtemp_sol, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, dfluxsens, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'fluxlat',  itau_sechiba, dfluxlat,  iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'swnet',    itau_sechiba, dswnet,    iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'swdown',   itau_sechiba, dswdown,   iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'alb_vis',  itau_sechiba, dalbedo(:,1), iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'alb_nir',  itau_sechiba, dalbedo(:,2), iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'tair',     itau_sechiba, dtair, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'qair',     itau_sechiba, dqair, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 't2m',      itau_sechiba, dtair, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'q2m',      itau_sechiba, dqair, iim*jjm, kindex)
+          ENDIF
+       ELSE
+          CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+          CALL histwrite (hist_id, 'SWnet',    itau_sechiba, dswnet, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'Qh', itau_sechiba, dfluxsens, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'Qle',  itau_sechiba, dfluxlat, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'RadT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+          !
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'SWnet',    itau_sechiba, dswnet, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'Qh', itau_sechiba, dfluxsens, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'Qle',  itau_sechiba, dfluxlat, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'RadT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+          ENDIF
+       ENDIF
+       !
+       IF (dw .EQ. xrdt) 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
+    !
+    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 '
+    !
+    CALL ipslnlf(new_number=old_fileout)
+    !        
+  END SUBROUTINE intersurf_gathered
+!
+!
+#ifdef CPP_PARA
+  SUBROUTINE intersurf_gathered_2m (kjit, iim_glo, jjm_glo, offset, kjpindex, kindex, communicator, 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) 
+     & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, &
+! Ajout Nathalie - passage q2m/t2m pour calcul Rveget
+     & q2m, t2m, &
+! Add emission/deposit fields
+     & field_out_names, fields_out, field_in_names, fields_in)  
+#else
+  SUBROUTINE intersurf_gathered_2m (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)
+     & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, &
+! Ajout Nathalie - passage q2m/t2m pour calcul Rveget
+     & q2m, t2m, &
+! Add emission/deposit fields
+     & field_out_names, fields_out, field_in_names, fields_in)
+#endif
+    ! 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_glo, jjm_glo  !! Dimension of global fields
+#ifdef CPP_PARA
+    INTEGER(i_std),INTENT (in)                            :: offset        !! offset between the first global 2D point 
+                                                                           !! and the first local 2D point.
+    INTEGER(i_std),INTENT(IN)                             :: communicator  !! Orchidee communicator
+#endif
+    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
+! Ajout Nathalie - Juin 2006 - q2m/t2m pour calcul Rveget
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: q2m          !! Surface specific humidity
+    REAL(r_std),DIMENSION (kjpindex), INTENT(in)          :: t2m          !! Surface air temperature
+    ! 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
+    !
+    ! 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
+    !
+    ! 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.
+    !
+    ! Scattered variables for diagnostics
+    !
+!    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dvevapp       !! Diagnostic array for evaporation
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dtemp_sol     !! for surface temperature
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dfluxsens     !! for sensible heat flux
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dfluxlat      !! for latent heat flux
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dswnet        !! net solar radiation
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dswdown       !! Incident solar radiation
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:,:)                     :: dalbedo       !! albedo
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dtair         !! air temperature
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dqair         !! specific air humidity
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dq2m          !! Surface specific humidity
+    REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:)                       :: dt2m          !! Surface air temperature
+    !
+    !
+    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 = .FALSE.
+    INTEGER(i_std),DIMENSION (kjpindex)                  :: kindex_p
+    !
+    LOGICAL, SAVE                                         :: fatmco2       !! Flag to force the value of atmospheric CO2 for vegetation.
+    REAL(r_std), SAVE                                     :: atmco2        !! atmospheric CO2 
+    !
+    ! 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
+    ! Id of fields to give (nb_fields_out) or get from (nb_fields_in) GCM :
+    INTEGER(i_std)                                        :: i_fields_out, i_fields_in
+    !
+    CALL ipslnlf(old_number=old_fileout)
+    !
+    IF (l_first_intersurf) THEN
+       !
+       CALL intsurf_time( kjit, date0, xrdt )
+       !
+       IF ( check ) WRITE(numout,*) 'Initialisation of intersurf'
+       !
+       CALL ioget_calendar (one_year, one_day)
+       !
+#ifdef CPP_PARA
+       CALL init_para(.TRUE.,communicator)
+       kindex_p(:)=kindex(:) + offset
+#else
+       CALL init_para(.FALSE.)
+       kindex_p(:)=kindex(:)
+#endif
+       CALL ipslnlf(new_number=numout)
+       !
+       CALL init_data_para(iim_glo,jjm_glo,kjpindex,kindex_p)
+       iim=iim_glo
+       jjm=jj_nb
+       ALLOCATE(lon_scat(iim,jjm))
+       ALLOCATE(lat_scat(iim,jjm))
+!       ALLOCATE(dvevapp(iim*jjm))
+       ALLOCATE(dtemp_sol(iim*jjm))
+       ALLOCATE(dfluxsens(iim*jjm))
+       ALLOCATE(dfluxlat(iim*jjm))
+       ALLOCATE(dswnet(iim*jjm))
+       ALLOCATE(dswdown(iim*jjm))
+       ALLOCATE(dalbedo(iim*jjm,2))
+       ALLOCATE(dtair(iim*jjm))
+       ALLOCATE(dqair(iim*jjm)) 
+       ALLOCATE(dq2m(iim*jjm))
+       ALLOCATE(dt2m(iim*jjm))
+      
+!       CALL init_WriteField_p(kindex)
+       !
+       ! 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 ( .TRUE. ) THEN
+          
+          lon_scat(:,:)=zero
+          lat_scat(:,:)=zero 
+          CALL scatter2D(lon_scat_g,lon_scat)
+          CALL scatter2D(lat_scat_g,lat_scat)
+          lon_scat(:,1)=lon_scat(:,2)
+          lon_scat(:,jj_nb)=lon_scat(:,2)
+          lat_scat(:,1)=lat_scat(iim,1)
+          lat_scat(:,jj_nb)=lat_scat(1,jj_nb)
+          
+          tmp_lon(:,:) = lon_scat(:,:)
+          tmp_lat(:,:) = lat_scat(:,:)
+
+          IF (is_root_prc) THEN
+             lon_g(:,:) = lon_scat_g(:,:)
+             lat_g(:,:) = lat_scat_g(:,:)
+          ENDIF
+
+       ELSE
+          !
+          WRITE(numout,*) 'intersurf_gathered : We try to guess to full grid of the model.' 
+          WRITE(numout,*) 'I might fail, please report if it does. '
+          !
+          tmp_lon(:,:) = val_exp
+          tmp_lat(:,:) = val_exp
+          !
+          DO ik=1, kjpindex
+             j = INT( (kindex(ik)-1) / iim ) + 1
+             i = kindex(ik) - (j-1) * iim
+             tmp_lon(i,j) = lalo(ik,2)
+             tmp_lat(i,j) = lalo(ik,1)
+          ENDDO
+          !
+          ! Here we fill out the grid. To do this we do the strong hypothesis
+          ! that the grid is regular. Will this work in all cases ????
+          !
+          DO i=1,iim
+             mx = MAXVAL(tmp_lon(i,:), MASK=tmp_lon(i,:) .LT. val_exp)
+             IF ( mx .LT. val_exp ) THEN
+                tmp_lon(i,:) = mx
+             ELSE
+                WRITE(numout,*) 'Could not find a continental point on this longitude. Thus the grid'
+                WRITE(numout,*) 'could not be completed.'
+                STOP 'intersurf_gathered'
+             ENDIF
+          ENDDO
+          !
+          DO j=1,jjm
+             mx = MAXVAL(tmp_lat(:,j), MASK=tmp_lat(:,j) .LT. val_exp)
+             IF ( mx .LT. val_exp ) THEN
+                tmp_lat(:,j) = mx
+             ELSE
+                WRITE(numout,*) 'Could not find a continental point on this latitude. Thus the grid'
+                WRITE(numout,*) 'could not be completed.'
+                STOP 'intersurf_gathered'
+             ENDIF
+          ENDDO
+
+          CALL gather2D(tmp_lon,lon_g)
+          CALL gather2D(tmp_lat,lat_g)
+
+       ENDIF
+       !
+       DO ik=1, kjpindex
+          j = INT( (kindex(ik)-1) / iim ) + 1
+          i = kindex(ik) - (j-1) * iim
+          tmp_lev(i,j) = zlev(ik)
+       ENDDO
+       CALL gather2D(tmp_lev,zlev_g)
+       !
+       !
+       !  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)
+       !
+       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
+       !
+
+       ! 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
+
+       IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf'
+       !
+    ENDIF
+    !
+    CALL ipslnlf(new_number=numout)
+    !
+    !  Shift the time step to phase the two models
+    !
+    itau_sechiba = kjit + itau_offset
+    !
+    CALL intsurf_time( itau_sechiba, date0_shifted, xrdt )
+    !
+    ! 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,*) "Index for continental points = ",kindex
+       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
+       WRITE(numout,*) "Geographical coordinates lon = ", lon_scat
+       WRITE(numout,*) "Geographical coordinates lat = ", lat_scat 
+       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 (3,'intsurf_gathered_2m', &
+            &          '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
+       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)
+       IF ( control_flags%ok_stomate ) THEN
+          CALL histwrite(hist_id_stom, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+          IF ( hist_id_stom_ipcc > 0 ) &
+               CALL histwrite(hist_id_stom_IPCC, 'Areas',  itau_sechiba+1, area, kjpindex, kindex)
+       ENDIF
+       CALL histwrite(hist_id, 'Contfrac',  itau_sechiba+1, contfrac, kjpindex, kindex)
+       CALL histsync(hist_id)
+       !
+       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
+    !
+    ! 4. 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
+!       & 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, 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 ) 
+    
+    !
+    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
+    !    
+!    dvevapp(:)    = undef_sechiba
+    dtemp_sol(:)  = undef_sechiba
+    dfluxsens(:)  = undef_sechiba
+    dfluxlat(:)   = undef_sechiba
+    dswnet (:)    = undef_sechiba
+    dswdown (:)   = undef_sechiba
+    dalbedo (:,1) = undef_sechiba
+    dalbedo (:,2) = undef_sechiba
+    dtair (:)     = undef_sechiba
+    dqair (:)     = undef_sechiba
+    dt2m (:)      = undef_sechiba
+    dq2m (:)      = undef_sechiba
+    !
+    DO ik=1, kjpindex
+       
+       z0(ik)           = zz0(ik)
+       coastalflow(ik)  = zcoastal(ik)/1000.
+       riverflow(ik)    = zriver(ik)/1000.
+       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)
+       
+       ! Fill up the diagnostic arrays
+
+!       dvevapp(kindex(ik))    = zvevapp(ik)
+       dtemp_sol(kindex(ik))  = ztemp_sol_new(ik)
+       dfluxsens(kindex(ik))  = zfluxsens(ik)
+       dfluxlat(kindex(ik))   = zfluxlat(ik)
+       dswnet (kindex(ik))    = swnet(ik)
+       dswdown (kindex(ik))   = swdown(ik)
+       dalbedo (kindex(ik),1) = zalbedo(ik,1)
+       dalbedo (kindex(ik),2) = zalbedo(ik,2)   
+       dtair (kindex(ik))     = temp_air(ik)
+       dqair (kindex(ik))     = qair(ik)
+       dt2m (kindex(ik))      = t2m(ik)
+       dq2m (kindex(ik))      = q2m(ik)
+       !
+    ENDDO
+    !
+    ! Modified fields for variables scattered during the writing
+    !
+    dcoastal(:) = (zcoastal(:))/1000.
+    driver(:)   = (zriver(:))/1000.
+    !
+    IF ( .NOT. l_first_intersurf) THEN
+       !
+       IF ( .NOT. almaoutput ) THEN
+          !
+          !  scattered during the writing
+          !           
+          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, dtemp_sol, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'tsol_max', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'tsol_min', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'fluxsens', itau_sechiba, dfluxsens, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'fluxlat',  itau_sechiba, dfluxlat,  iim*jjm, kindex)
+          CALL histwrite (hist_id, 'swnet',    itau_sechiba, dswnet,    iim*jjm, kindex)
+          CALL histwrite (hist_id, 'swdown',   itau_sechiba, dswdown,   iim*jjm, kindex)
+          CALL histwrite (hist_id, 'alb_vis',  itau_sechiba, dalbedo(:,1), iim*jjm, kindex)
+          CALL histwrite (hist_id, 'alb_nir',  itau_sechiba, dalbedo(:,2), iim*jjm, kindex)
+          CALL histwrite (hist_id, 'tair',     itau_sechiba, dtair, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'qair',     itau_sechiba, dqair, iim*jjm, kindex)
+          CALL histwrite (hist_id, 't2m',      itau_sechiba, dq2m, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'q2m',      itau_sechiba, dt2m, iim*jjm, kindex)
+          !
+          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, dtemp_sol, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, dfluxsens, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'fluxlat',  itau_sechiba, dfluxlat,  iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'swnet',    itau_sechiba, dswnet,    iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'swdown',   itau_sechiba, dswdown,   iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'alb_vis',  itau_sechiba, dalbedo(:,1), iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'alb_nir',  itau_sechiba, dalbedo(:,2), iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'tair',     itau_sechiba, dtair, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'qair',     itau_sechiba, dqair, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 't2m',      itau_sechiba, dq2m, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'q2m',      itau_sechiba, dt2m, iim*jjm, kindex)
+          ENDIF
+       ELSE
+          CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+          CALL histwrite (hist_id, 'SWnet',    itau_sechiba, dswnet, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'Qh', itau_sechiba, dfluxsens, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'Qle',  itau_sechiba, dfluxlat, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+          CALL histwrite (hist_id, 'RadT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+          !
+          IF ( hist2_id > 0 ) THEN
+             CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
+             CALL histwrite (hist2_id, 'SWnet',    itau_sechiba, dswnet, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'Qh', itau_sechiba, dfluxsens, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'Qle',  itau_sechiba, dfluxlat, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+             CALL histwrite (hist2_id, 'RadT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
+          ENDIF
+       ENDIF
+       !
+       IF (dw .EQ. xrdt) 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
+    !
+    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 (3,'intsurf_gathered_2m', &
+            &          '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 '
+    !
+    CALL ipslnlf(new_number=old_fileout)
+    !        
+  END SUBROUTINE intersurf_gathered_2m
+!
+  !-------------------------------------------------------------------------------------
+  !
+  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
+       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
+
+    !
+    !Config Key  = LONGPRINT
+    !Config Desc = ORCHIDEE will print more messages
+    !Config Def  = n
+    !Config Help = This flag permits to print more debug messages in the run.
+    !
+    long_print = .FALSE.
+    CALL getin_p('LONGPRINT',long_print)
+    !
+    !Config Key  = CHECKTIME
+    !Config Desc = ORCHIDEE will print messages on time
+    !Config Def  = n
+    !Config Help = This flag permits to print debug messages on the time.
+    !
+    check_time = .FALSE.
+    CALL getin_p('CHECKTIME',check_time)
+    !
+    !
+    !Config Key  = ORCHIDEE_WATCHOUT
+    !Config Desc = ORCHIDEE will write out its forcing to a file
+    !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.
+    !
+    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. 
+       !
+       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. 
+       !
+       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 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.
+    !
+    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 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.
+    !
+    control_flags%hydrol_cwrr = .FALSE.
+    CALL getin_p('HYDROL_CWRR', control_flags%hydrol_cwrr)
+    IF ( control_flags%hydrol_cwrr ) then
+       CALL ipslerr (2,'intsurf_config', &
+            &          'You will use in this run the second version of CWRR hydrology in ORCHIDEE.',&
+            &          'This model hasn''t been tested for global run yet.', &
+            &          '(check your parameters)')
+    ENDIF
+    !
+    !Config Key  = STOMATE_OK_CO2
+    !Config Desc = Activate CO2?
+    !Config Def  = n
+    !Config Help = set to TRUE if photosynthesis is to be activated
+    !
+    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 Def  = n
+    !Config Help = set to TRUE if STOMATE is to be activated
+    !
+    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 Def  = n
+    !Config Help = set to TRUE if DGVM is to be activated
+    !
+    control_flags%ok_dgvm = .FALSE.
+    CALL getin_p('STOMATE_OK_DGVM',control_flags%ok_dgvm)
+
+    !
+    ! 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.
+    !
+    !Config Key  = STOMATE_WATCHOUT
+    !Config Desc = STOMATE does minimum service
+    !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.
+    !
+    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.
+    !
+    !
+    RETURN
+    !
+  END SUBROUTINE intsurf_config
+  !
+  !
+  !
+  SUBROUTINE intsurf_restart(istp, iim, jjm, lon, lat, date0, dt, control_flags, rest_id, rest_id_stom, itau_offset)
+    !
+    !  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
+    !
+    CHARACTER(LEN=80)          :: restname_in, restname_out, stom_restname_in, stom_restname_out
+    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  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.
+!-
+    restname_in = 'NONE'
+    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 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.
+    !
+    restname_out = 'restart_out.nc'
+    CALL getin_p('SECHIBA_rest_out', restname_out)
+    !
+    !Config Key  = SECHIBA_reset_time
+    !Config Desc = Option to overrides the time of the restart
+    !Config Def  = n
+    !Config Help = This option allows the model to override the time
+    !Config        found in the restart file of SECHIBA with the time
+    !Config        of the first call. That is the restart time of the GCM.
+    !
+    overwrite_time = .FALSE.
+    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
+       !Config         of STOMATE
+       !Config  If   = STOMATE_OK_STOMATE || 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.
+       !-
+       stom_restname_in = 'NONE'
+       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 || 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.
+       !-
+       stom_restname_out = 'stomate_restart.nc'
+       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)
+    !
+    !   
+    !  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=30)   :: 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, &
+    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, 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, 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
+! 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(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
+    !
+    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  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.
+    !-
+    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
+    !Config         to be written
+    !Config  Def  = cabauw_out.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.
+    !-
+    histname='cabauw_out.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  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 !
+    !-
+    dw = one_day
+    CALL getin_p('WRITE_STEP', dw)
+    !
+    veg(1:nvm)   = (/ (REAL(i,r_std),i=1,nvm) /)
+    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_sc,'("(ave(X)*",F8.1,")")') one_day/dt
+    WRITE(flux_insec,'("ave(X*",F8.6,")")') un/dt
+    WRITE(flux_scinsec,'("ave(scatter(X*",F8.6,"))")') un/dt
+    WRITE(numout,*) flux_op, one_day/dt, dt, dw
+    !-
+    !Config  Key  = SECHIBA_HISTLEVEL
+    !Config  Desc = SECHIBA history output level (0..10)
+    !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         web under documentation.
+    !-
+    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(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
+    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(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(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
+    ! 
+    !-
+    !- Check if we have by any change a rectilinear grid. This would allow us to 
+    !- simplify the output files.
+    !
+    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
+    !-
+    !-
+    hist_id = -1
+    !-
+    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, '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, solay, 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%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, 'nobiofrac', 'Fraction of other surface types', '1', &
+            & iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
+       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)
+             
+          ENDDO
+       ENDIF
+       !-
+       !- 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', '1',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+          CALL histdef(hist_id, 'bqsb', 'Lower Soil Moisture', '1',  &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
+       ELSE
+          CALL histdef(hist_id, 'humtot', 'Total Soil Moisture', 'Kg/m2', &
+               & 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/m2', &
+               & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, avescatter(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)
+       CALL histdef(hist_id, 'temp_pheno', 'Temperature for Pheno', 'K',  &
+            & 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)
+          CALL histdef(hist_id, 'irrigation', 'Net irrigation', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(7), dt,dw)
+          CALL histdef(hist_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(7), dt,dw)
+          CALL histdef(hist_id, 'irrigmap', 'Map of irrigated areas', 'm^2', &
+               & iim,jjm, hori_id, 1,1,1, -99, 32, once(7), dt,dw)
+       ENDIF
+       !-
+       !- SECHIBA_HISTLEVEL = 8
+       !-
+       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
+!MM
+       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, 'vbetaco2', 'beta for CO2', 'mm/d', &
+            & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(8), dt,dw)
+       CALL histdef(hist_id, 'soiltype', 'Fraction of soil textures', '%', &
+            & iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, once(8),  dt,dw)
+       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
+       !-
+       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, '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)
+       CALL histdef(hist_id, 'rsol', 'Soil resistance', 's/m',  &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(10), dt,dw)
+       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, avescatter(11), dt,dw)
+
+          CALL histdef(hist_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
+               & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(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, avescatter(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, avescatter(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, avescatter(11), dt,dw)
+
+       CALL histdef(hist_id, 'tran', "Transpiration", "kg m-2 s-1", &
+            & iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(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)
+
+    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, solay, 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, '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, 'DelSWE', 'Change in SWE','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)
+    !-
+    !- 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, '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, 'SWE', '3D soil 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, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
+            & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
+       CALL histdef(hist_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
+            & iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 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, '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)
+    !-
+    !-
+    !-  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, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
+            & iim,jjm, hori_id, 1,1,1, -99, 32, once(7), 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)
+       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
+    !-
+    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)
+    !-
+    CALL histend(hist_id)
+    !
+    !
+    ! Second SECHIBA hist file
+    !
+    !-
+    !Config  Key  = SECHIBA_HISTFILE2
+    !Config  Desc = Flag to switch on histfile 2 for SECHIBA (hi-frequency ?)
+    !Config  Def  = FALSE
+    !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 MM is it right ? Second output file is produced with the same level 
+    !Config         as the first one.
+    !-
+    ok_histfile2=.FALSE.
+    CALL getin_p('SECHIBA_HISTFILE2', ok_histfile2)
+    WRITE(numout,*) 'SECHIBA_HISTFILE2 ', ok_histfile2
+    !
+    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
+       !Config         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.
+       !-
+       histname2='sechiba_out_2.nc'
+       CALL getin_p('SECHIBA_OUTPUT_FILE2', histname2)
+       WRITE(numout,*) 'SECHIBA_OUTPUT_FILE2 ', histname2
+       !-
+       !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 !
+       !-
+       dw2 = 1800.0
+       CALL getin_p('WRITE_STEP2', dw2)
+       !-
+       !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.
+       !-
+       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(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(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(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(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 ( .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, '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, avescatter2(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)
+          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
+          !-
+          !- 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)
+
+             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', '1',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
+             CALL histdef(hist2_id, 'bqsb', 'Lower Soil Moisture', '1',  &
+                  & iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
+          ELSE
+             CALL histdef(hist2_id, 'humtot', 'Total Soil Moisture', 'Kg/m2', &
+                  & 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/m2', &
+                  & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 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(2), 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(2), 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(2), 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(2), 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(2), 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)
+          CALL histdef(hist2_id, 'temp_pheno', 'Temperature for Pheno', 'K',  &
+               & 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, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
+                  & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
+             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
+          !-
+          !- 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)
+          CALL histdef(hist2_id, 'vbetaco2', 'beta for CO2', 'mm/d', &
+               & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
+          CALL histdef(hist2_id, 'soiltype', 'Fraction of soil textures', '%', &
+               & iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, once2(9),  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)
+          !-
+          !- SECHIBA_HISTLEVEL2 = 10
+          !-
+          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)
+          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)
+          CALL histdef(hist2_id, 'rsol', 'Soil resistance', 's/m',  &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt, dw2)
+          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)
+          ! 
+       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, solay, 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(2), dt, dw2)
+          CALL histdef(hist2_id, 'Qv', 'Energy of sublimation', 'W/m^2',  &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), 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(1), 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(1), 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(1), dt, dw2)
+          CALL histdef(hist2_id, 'DelSWE', 'Change in SWE','kg/m^2',&
+               & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(1), dt, dw2)
+          CALL histdef(hist2_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2',  &
+               & iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(1), 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(1), dt, dw2)
+          CALL histdef(hist2_id, 'Albedo', 'Albedo', '1', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+          CALL histdef(hist2_id, 'SWE', '3D soil water equivalent','kg/m^2',  &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+          !!-
+          !-  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(1), 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(1), 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(1), 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, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
+          CALL histdef(hist2_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
+               & iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), 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(1), 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(1), dt, dw2)
+          !-
+          !-
+          !-  Cold Season Processes
+          !-
+          CALL histdef(hist2_id, 'SnowFrac', 'Snow cover fraction', '1',  &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+          CALL histdef(hist2_id, 'SAlbedo', 'Snow albedo', '1', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
+          CALL histdef(hist2_id, 'SnowDepth', '3D snow depth', 'm', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), 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(7), dt, dw2)
+          CALL histdef(hist2_id, 'dis', 'Simulated River Discharge', 'm^3/s', &
+               & iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), 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)
+       !-
+       CALL histend(hist2_id)
+    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
+       !Config         to be written
+       !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.
+       !-
+       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 (d)
+       !Config  Def  = 10.
+       !Config  Help = Time step of the STOMATE history file
+       !-
+       hist_days_stom = 10.
+       CALL getin_p('STOMATE_HIST_DT', hist_days_stom)       
+       IF ( hist_days_stom == moins_un ) THEN
+          hist_dt_stom = moins_un
+          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
+
+       ! 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 ) THEN
+          IF (dt_slow_ > hist_dt_stom) THEN
+             WRITE(numout,*) "DT_SLOW = ",dt_slow_,"  , STOMATE_HIST_DT = ",hist_dt_stom
+             CALL ipslerr (3,'intsurf_history', &
+                  &          'Problem with DT_SLOW > STOMATE_HIST_DT','', &
+                  &          '(must be less or equal)')
+          ENDIF
+       ENDIF
+       !-
+       !- initialize
+       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
+       !- 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)
+
+       !- 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)
+
+       !- 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
+       !Config         to be written
+       !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.
+       !-
+       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 (d)
+       !Config  Def  = 0.
+       !Config  Help = Time step of the STOMATE IPCC history file
+       !-
+       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 (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, &
+                  &     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)
+
+          !- end definition
+          CALL histend(hist_id_stom_IPCC)
+          
+       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)
+    ! 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
+    !-
+    !- 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  Def  = 10
+    !Config  Help = 0: nothing is written; 10: everything is written
+    !-
+    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
+    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                    "), &
+         &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_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                     "), &
+         &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_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 litter carbon                      "), &
+         &               TRIM("gC/m^2              "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_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                      "), &
+         &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_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                        "), &
+         &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_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                     "), &
+         &               TRIM("gC/m^2/pft          "), iim,jjm, hist_hori_id, &
+         &               nvm,1,nvm, hist_PFTaxis_id,32, ave(5), 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)
+
+    ! Vegetation fraction                               
+    CALL histdef (hist_id_stom, &
+         &               TRIM("VEGET               "), &
+         &               TRIM("Vegetation fraction                               "), &
+         &               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("TIME_LOWGPP         "), &
+         &               TRIM("Time elapsed since the end of GPP                 "), &
+         &               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("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)
+
+    !---------------------------------
+  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: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/routing.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/routing.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/routing.f90	(revision 854)
@@ -0,0 +1,5322 @@
+!!
+!!
+!! This module routes the water over the continents into the oceans.
+!!
+!! 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
+!!
+!! @author 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 routing
+  !
+  !
+  ! routines called : restput, restget
+  !
+  USE ioipsl   
+  !
+  USE constantes
+  USE constantes_veg
+  USE sechiba_io
+  USE grid
+  USE parallel
+  !
+  IMPLICIT NONE
+  !
+  ! public routines :
+  !
+  PRIVATE
+  PUBLIC :: routing_main, routing_clear
+  !
+  ! variables used inside hydrol module : declaration and initialisation
+  !
+  LOGICAL, SAVE                                     :: l_first_routing=.TRUE. !! Initialisation has to be done one time
+  LOGICAL, SAVE                                     :: check_waterbal=.FALSE. !! The check the water balance
+  !
+  !  The maximum number of basins we wish to have per grid-box (truncation of the model)
+  INTEGER(i_std), PARAMETER                         :: nbasmax=5
+  !  The maximum number of bassins we can handle at any time during the generation of the maps.
+  INTEGER(i_std), PARAMETER                          :: nbvmax = 220
+  !
+  !  The time constants are in days.
+  ! 
+  REAL(r_std), PARAMETER                             :: fast_tcst = 3.0, slow_tcst = 25.0, stream_tcst = 0.24 
+  REAL(r_std), PARAMETER                             :: evap_cst = 0.18, wdelay_cst = 0.7
+  !
+  !  Maximum evaporation rate from lakes 7.5 kg/m^2/d transformed into kg/m^2/sec
+  !
+  REAL(r_std), PARAMETER                             :: maxevap_lake = 7.5/86400.
+  !
+  !  Parameter for the Kassel irrigation parametrization linked to the crops
+  !
+  REAL(r_std), PARAMETER                             :: crop_coef = 1.5
+  !
+  INTEGER(i_std), PARAMETER                         :: undef_int = 999999999
+  !
+  REAL(r_std),SAVE                                   :: dt_routing
+  !
+  ! Logicals to control model configuration
+  !
+  LOGICAL, SAVE                                     :: doirrigation = .FALSE.
+  LOGICAL, SAVE                                     :: dofloodplains = .FALSE.
+  !
+  !
+  ! The variables describing the basins and their routing, need to be in the restart file.
+  !
+  INTEGER(i_std), SAVE                               :: num_largest
+  REAL(r_std), SAVE                                  :: time_counter
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: routing_area_loc
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: topo_resid_loc
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_togrid_loc
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_tobasin_loc
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: global_basinid_loc
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)          :: hydrodiag_loc    !! Variable to diagnose the hydrographs
+  !
+  ! parallelism
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: routing_area_glo
+  REAL(r_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)     :: topo_resid_glo
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_togrid_glo
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: route_tobasin_glo
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)  :: global_basinid_glo
+  INTEGER(i_std), SAVE, ALLOCATABLE, TARGET, DIMENSION(:,:)          :: hydrodiag_glo    !! Variable to diagnose the hydrographs
+
+  REAL(r_std), SAVE, POINTER, DIMENSION(:,:)     :: routing_area
+  REAL(r_std), SAVE, POINTER, DIMENSION(:,:)     :: topo_resid
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)  :: route_togrid
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)  :: route_tobasin
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)  :: global_basinid
+  INTEGER(i_std), SAVE, POINTER, DIMENSION(:,:)  :: hydrodiag
+  ! Map of irrigated areas and floodplains
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: irrigated          ! Surface which can be irrigate in each grid-box
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: floodplains        ! Surface which can be inondated in each grid-box
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)   :: previous_outflow
+  !
+  ! The reservoirs, also to be put into the restart file.
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)   :: fast_reservoir, slow_reservoir, stream_reservoir
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: lake_reservoir
+  !
+  ! The accumulated fluxes.
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: runoff_mean, drainage_mean, evapot_mean
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: precip_mean, humrel_mean, totnobio_mean, vegtot_mean
+  !
+  ! The averaged outflow fluxes.
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: lakeinflow_mean
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: returnflow_mean, irrigation_mean
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: riverflow_mean, coastalflow_mean
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: floodtemp
+  INTEGER(i_std), SAVE                             :: floodtemp_lev
+  !
+  ! Diagnostic variables ... well sort of !
+  !
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: irrig_netereq
+  !
+  ! Hydrographs at the outflow of the grid box for major basins
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: hydrographs 
+  ! Diagnostics for the various reservoirs we use (Kg/m^2)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)     :: fast_diag, slow_diag, stream_diag, lake_diag
+  !
+CONTAINS
+  !
+  !---------------------------------------------------------------------------------
+  !
+  SUBROUTINE routing_main(kjit, nbpt, dtradia, ldrestart_read, ldrestart_write, index, &
+       & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, runoff, &
+       & drainage, evapot, precip_rain, humrel, &
+       & stempdiag, returnflow, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id)
+    !
+    IMPLICIT NONE
+    !
+    ! This module will route the runoff and drainage produced by the hydrol module. These two
+    ! fluxes are provided in kg/m^2dt. 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 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 river reservoir and beeing put into the upper 
+    !                 layers of the soil.
+    ! The two first fluxes are in kg/dt and the last one is on kg/m^2dt.
+    !
+    INTEGER(i_std), INTENT(in)    :: kjit                !! Time step number
+    INTEGER(i_std), INTENT(in)    :: nbpt                !! 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
+    INTEGER(i_std), INTENT(in)    :: index(nbpt)         ! Indeces of the points on the 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 in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)      ! Fraction of land in each grid box
+    REAL(r_std), INTENT(in)       :: totfrac_nobio(nbpt) ! Total fraction of continental ice+lakes+...
+    REAL(r_std), INTENT(in)       :: veget_max(nbpt,nvm) ! Maximum vegetation fraction. We want to have the 
+                                                        ! part of the grid which can have some vegetation.
+    REAL(r_std), INTENT(in)       :: runoff(nbpt)        ! grid-point runoff
+    REAL(r_std), INTENT(in)       :: drainage(nbpt)      ! grid-point drainage
+    REAL(r_std), INTENT(in)       :: evapot(nbpt)        ! Potential evaporation
+    REAL(r_std), INTENT(in)       :: precip_rain(nbpt)   ! Rainfall needed for the irrigation formula
+    REAL(r_std), INTENT(in)       :: humrel(nbpt,nvm)    ! Soil moisture stress
+    REAL(r_std), INTENT(in)       :: stempdiag(nbpt,nbdl)! Temperature profile in soil
+    !
+    REAL(r_std), INTENT(out)      :: returnflow(nbpt)    ! The water flow which returns to the grid box (kg/m^2 per dt)
+    REAL(r_std), INTENT(out)      :: irrigation(nbpt)    ! Irrigation flux (kg/m^2 per dt)
+    REAL(r_std), INTENT(out)      :: riverflow(nbpt)     ! Outflow of the major rivers
+    REAL(r_std), INTENT(out)      :: coastalflow(nbpt)   ! Outflow on coastal points by small basins    
+    !
+    ! LOCAL
+    !
+    CHARACTER(LEN=30)            :: var_name
+    REAL(r_std), DIMENSION(1)     :: tmp_day
+    REAL(r_std), DIMENSION(nbpt)  :: return_lakes
+    INTEGER(i_std)               :: ig, jv
+    LOGICAL, SAVE                 :: init_irrig=.FALSE., init_flood=.FALSE.
+    !
+    ! do initialisation
+    !
+    IF (l_first_routing) THEN
+       !
+       ! 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, dtradia, returnflow, irrigation, &
+            &             riverflow, coastalflow, 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 needed.
+       !
+       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
+       !
+       IF ( doirrigation .OR. dofloodplains ) 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 ( init_irrig .OR. init_flood ) THEN
+             CALL routing_irrigmap(nbpt, index, lalo, neighbours, resolution, &
+                 contfrac, init_irrig, irrigated, init_flood, floodplains, hist_id, hist2_id)
+          ENDIF
+
+       ENDIF
+       !
+       ! This routine gives a diag nostic of the basins used.
+       !
+       CALL routing_diagnostic_p(nbpt, index, resolution, contfrac, hist_id, hist2_id)
+       !
+       l_first_routing = .FALSE.
+       !
+       RETURN
+       !
+    ENDIF
+    !
+    ! Accumulate the incoming water fluxes
+    !
+    runoff_mean(:) = runoff_mean(:) + runoff(:)
+    drainage_mean(:) = drainage_mean(:) + drainage(:)
+    evapot_mean(:) = evapot_mean(:) + evapot(:)
+    floodtemp(:) = stempdiag(:,floodtemp_lev)
+    precip_mean(:) =  precip_mean(:) + precip_rain(:)
+    !
+    ! Averaged variables (i.e. *dtradia/dt_routing)
+    !
+    totnobio_mean(:) = totnobio_mean(:) + totfrac_nobio(:)*dtradia/dt_routing
+    !
+    ! Only potentially vegetated surfaces are taken into account. At the start of
+    ! the growing seasons (when veget and veget_max are still different) we will
+    ! 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 
+    !
+    ! If the time has come we do the routing.
+    !
+    IF ( NINT(time_counter) .GE. NINT(dt_routing) ) THEN 
+       !
+       ! Check the water balance if needed
+       !
+       IF ( check_waterbal ) THEN
+          CALL routing_waterbal(nbpt, .TRUE., runoff_mean, drainage_mean, returnflow_mean, &
+               & irrigation_mean, riverflow_mean, coastalflow_mean)
+       ENDIF
+       !
+       ! Make sure we do not flood north of 49N
+       !
+       DO ig=1,nbpt
+          IF ( lalo(ig,1) > 49.0 ) THEN
+             floodtemp(ig) = tp_00 - un
+          ENDIF
+       ENDDO
+       !
+       CALL routing_flow(nbpt, dt_routing, runoff_mean, drainage_mean, &
+            & vegtot_mean, totnobio_mean, evapot_mean, precip_mean, humrel_mean, floodtemp, &
+            & lakeinflow_mean, returnflow_mean, irrigation_mean, riverflow_mean, &
+            & coastalflow_mean, hydrographs)
+       !
+       CALL routing_lake(nbpt, dt_routing, lakeinflow_mean, humrel_mean, return_lakes)
+       !
+       returnflow_mean(:) = returnflow_mean(:) + return_lakes(:)
+       !
+       ! Close the water balance if asked for
+       !
+       IF ( check_waterbal ) THEN
+          CALL routing_waterbal(nbpt, .FALSE., runoff_mean, drainage_mean, returnflow_mean, &
+               & irrigation_mean, riverflow_mean, coastalflow_mean)
+       ENDIF
+       !
+       time_counter = zero
+       !
+       runoff_mean(:) = zero
+       drainage_mean(:) = zero
+       evapot_mean(:) = zero
+       precip_mean(:) = zero
+       !
+       humrel_mean(:) = zero
+       totnobio_mean(:) = zero
+       vegtot_mean(:) = zero
+       !
+       ! 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
+       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
+       !
+       ! Convert from kg/dtradia to m^3/dtradia
+       !
+       hydrographs(:) = hydrographs(:)/1000.
+       !
+    ENDIF
+    !
+    ! Return the fraction of routed water for this time step.
+    !
+    returnflow(:) = returnflow_mean(:)
+    irrigation(:) = irrigation_mean(:)
+    riverflow(:) = riverflow_mean(:)
+    coastalflow(:) = coastalflow_mean(:)
+    !
+    ! 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 = 'fastres'
+       CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, fast_reservoir, 'scatter',  nbp_glo, index_g)
+       var_name = 'slowres'
+       CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, slow_reservoir, 'scatter',  nbp_glo, index_g)
+       var_name = 'streamres'
+       CALL restput_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, stream_reservoir, 'scatter',nbp_glo,index_g)
+       !
+       var_name = 'lakeres'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, lake_reservoir, 'scatter',  nbp_glo, index_g)
+       !
+       var_name = 'lakeinflow'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, lakeinflow_mean, 'scatter',  nbp_glo, index_g)
+       var_name = 'returnflow'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, returnflow_mean, 'scatter',  nbp_glo, index_g)
+       var_name = 'riverflow'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, riverflow_mean, 'scatter',  nbp_glo, index_g)
+       var_name = 'coastalflow'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, coastalflow_mean, 'scatter',  nbp_glo, index_g)
+       var_name = 'hydrographs'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, hydrographs, 'scatter',  nbp_glo, index_g)
+       !
+       ! Keep track of the accumulated variables
+       !
+       var_name = 'runoff_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, runoff_mean, 'scatter',  nbp_glo, index_g)
+       var_name = 'drainage_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, drainage_mean, 'scatter',  nbp_glo, index_g)
+       var_name = 'evapot_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, evapot_mean, 'scatter',  nbp_glo, index_g)
+       var_name = 'precip_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, precip_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 = 'vegtot_route'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, vegtot_mean, 'scatter',  nbp_glo, index_g)
+       !
+       var_name = 'previous_outflow'
+       CALL restput_p (rest_id, var_name, nbp_glo, nbasmax+3, 1, kjit,previous_outflow,'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)
+          var_name = 'irrigation'
+          CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, irrigation_mean, 'scatter',  nbp_glo, index_g)
+       ENDIF
+       !
+       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
+       !
+       RETURN
+       !
+    ENDIF
+    !
+    ! Write diagnostics
+    !
+    IF ( .NOT. almaoutput ) THEN
+       !
+       CALL histwrite(hist_id, 'riversret', kjit, returnflow, nbpt, index)
+       CALL histwrite(hist_id, 'hydrographs', kjit, hydrographs, nbpt, index)
+       !
+       CALL histwrite(hist_id, 'fastr', kjit, fast_diag, nbpt, index)
+       CALL histwrite(hist_id, 'slowr', kjit, slow_diag, nbpt, index)
+       CALL histwrite(hist_id, 'streamr', kjit, stream_diag, nbpt, index)
+       CALL histwrite(hist_id, 'lakevol', kjit, lake_diag, nbpt, index)
+       !
+       CALL histwrite(hist_id, 'irrigation', kjit, irrigation, nbpt, index)
+       !
+       CALL histwrite(hist_id, 'netirrig', kjit, irrig_netereq, nbpt, index)
+       !
+    ELSE
+       !
+       CALL histwrite(hist_id, 'dis', kjit, hydrographs, nbpt, index)
+       !
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          !
+          CALL histwrite(hist2_id, 'riversret', kjit, returnflow, nbpt, index)
+          CALL histwrite(hist2_id, 'hydrographs', kjit, hydrographs, nbpt, index)
+          !
+          CALL histwrite(hist2_id, 'fastr', kjit, fast_diag, nbpt, index)
+          CALL histwrite(hist2_id, 'slowr', kjit, slow_diag, nbpt, index)
+          CALL histwrite(hist2_id, 'streamr', kjit, stream_diag, nbpt, index)
+          CALL histwrite(hist2_id, 'lakevol', kjit, lake_diag, nbpt, index)
+          !
+          CALL histwrite(hist2_id, 'irrigation', kjit, irrigation, nbpt, index)
+          !
+          CALL histwrite(hist2_id, 'netirrig', kjit, irrig_netereq, nbpt, index)
+          !
+       ELSE
+          !
+          CALL histwrite(hist2_id, 'dis', kjit, hydrographs, nbpt, index)
+          !
+       ENDIF
+    ENDIF
+    !
+    !
+  END SUBROUTINE routing_main
+  !
+  !---------------------------------------------------------------------------------
+  !
+  SUBROUTINE routing_init(kjit, nbpt, index, dtradia, returnflow, irrigation, &
+       &                  riverflow, coastalflow, stempdiag, rest_id)
+    !
+    IMPLICIT NONE
+    !
+    ! interface description
+    ! input
+    !
+    INTEGER(i_std), INTENT(in)                     :: kjit          !! Time step number
+    INTEGER(i_std), INTENT(in)                     :: nbpt          !! Domain size  
+    INTEGER(i_std), DIMENSION (nbpt), INTENT(in)   :: index         !! Indeces of the points on the map
+    REAL(r_std), INTENT(in)                        :: dtradia       !! timestep
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)     :: returnflow     !! The water flow which returns to the grid box (kg/m^2 per dt)
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)     :: irrigation     !! Irrigation flow (kg/m^2 per dt)
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)     :: riverflow      !! Outflow of the major rivers
+    REAL(r_std), DIMENSION (nbpt),INTENT(out)     :: coastalflow    !! Outflow on coastal points by small basins 
+    REAL(r_std), DIMENSION(nbpt,nbdl),INTENT(in)  :: stempdiag      !! Temperature profile in soil
+    INTEGER(i_std), INTENT(in)                     :: rest_id       !! Restart file identifier
+    !
+    ! local declaration   
+    !
+    CHARACTER(LEN=80)                             :: var_name         !! To store variables names for I/O
+    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, totarea
+    INTEGER(i_std)                :: ier, ig, ib, ipn(1)
+    !
+    ! These variables will require the configuration infrastructure
+    !
+    !Config Key  = ROUTING_TIMESTEP
+    !Config If   = RIVER_ROUTING
+    !Config Desc = Time step of th 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.
+    !
+    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.
+    num_largest = 50
+    CALL getin_p('ROUTING_RIVERS', num_largest)
+    !
+    !Config Key  = DO_IRRIGATION
+    !Config Desc = Should we compute an irrigation flux 
+    !Config Def  = FALSE
+    !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.
+    !
+    doirrigation = .FALSE.
+    CALL getin_p('DO_IRRIGATION', doirrigation)
+    !
+    !Config Key  = DO_FLOODPLAINS
+    !Config Desc = Should we include floodplains 
+    !Config Def  = FALSE
+    !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.
+    !
+    dofloodplains = .FALSE.
+    CALL getin_p('DO_FLOODPLAINS', dofloodplains)
+    !
+    !
+    ! In order to simplify the time cascade check that dt_routing
+    ! is a multiple of dtradia
+    !
+    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.'
+       dt_routing = dtradia
+       WRITE(numout,*) 'THE NEW DT_ROUTING IS : ', dt_routing
+    ENDIF
+    !
+    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
+    !
+    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
+    !
+    ALLOCATE (fast_reservoir(nbpt,nbasmax))
+    var_name = 'fastres'
+    CALL ioconf_setatt('UNITS', 'Kg')
+    CALL ioconf_setatt('LONG_NAME','Water in the fast reservoir')
+    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., fast_reservoir, "gather", nbp_glo, index_g)
+    CALL setvar_p (fast_reservoir, val_exp, 'NO_KEYWORD', zero)
+    !
+    ALLOCATE (slow_reservoir(nbpt,nbasmax))
+    var_name = 'slowres'
+    CALL ioconf_setatt('UNITS', 'Kg')
+    CALL ioconf_setatt('LONG_NAME','Water in the slow reservoir')
+    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., slow_reservoir, "gather", nbp_glo, index_g)
+    CALL setvar_p (slow_reservoir, val_exp, 'NO_KEYWORD', zero)
+    !
+    ALLOCATE (stream_reservoir(nbpt,nbasmax))
+    var_name = 'streamres'
+    CALL ioconf_setatt('UNITS', 'Kg')
+    CALL ioconf_setatt('LONG_NAME','Water in the stream reservoir')
+    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax, 1, kjit, .TRUE., stream_reservoir, "gather", nbp_glo, index_g)
+    CALL setvar_p (stream_reservoir, val_exp, 'NO_KEYWORD', zero)
+    !
+    ALLOCATE (lake_reservoir(nbpt))
+    var_name = 'lakeres'
+    CALL ioconf_setatt('UNITS', 'Kg')
+    CALL ioconf_setatt('LONG_NAME','Water in the lake reservoir')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., lake_reservoir, "gather", nbp_glo, index_g)
+    CALL setvar_p (lake_reservoir, 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
+    !
+    ALLOCATE (previous_outflow(nbpt, nbasmax+3))
+    var_name = 'previous_outflow'
+    CALL ioconf_setatt('UNITS', 'm^3/dt')
+    CALL ioconf_setatt('LONG_NAME','Previous outflow from this basin')
+    CALL restget_p (rest_id, var_name, nbp_glo, nbasmax+3, 1, kjit, .TRUE., previous_outflow, "gather", nbp_glo, index_g)
+    CALL setvar_p (previous_outflow, val_exp, 'NO_KEYWORD', zero)
+    !
+    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
+    !
+    ! Put into the restart file the fluxes so that they can be regenerated at restart.
+    !
+    ALLOCATE (lakeinflow_mean(nbpt))
+    var_name = 'lakeinflow'
+    CALL ioconf_setatt('UNITS', 'Kg/dt')
+    CALL ioconf_setatt('LONG_NAME','Lake inflow')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., lakeinflow_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (lakeinflow_mean, val_exp, 'NO_KEYWORD', zero)
+    !
+    ALLOCATE (returnflow_mean(nbpt))
+    var_name = 'returnflow'
+    CALL ioconf_setatt('UNITS', 'Kg/m^2/dt')
+    CALL ioconf_setatt('LONG_NAME','Deep return flux')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., returnflow_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (returnflow_mean, val_exp, 'NO_KEYWORD', zero)
+    returnflow(:) = returnflow_mean(:)
+    !
+    ALLOCATE (irrigation_mean(nbpt))
+    ALLOCATE (irrig_netereq(nbpt))
+    irrig_netereq(:) = zero
+    !
+    IF ( doirrigation ) THEN
+       var_name = 'irrigation'
+       CALL ioconf_setatt('UNITS', 'Kg/dt')
+       CALL ioconf_setatt('LONG_NAME','Artificial irrigation flux')
+       CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., irrigation_mean, "gather", nbp_glo, index_g)
+       CALL setvar_p (irrigation_mean, val_exp, 'NO_KEYWORD', zero)
+    ELSE
+       irrigation_mean(:) = zero
+    ENDIF
+    irrigation(:) = irrigation_mean(:) 
+    !
+    ALLOCATE (riverflow_mean(nbpt))
+    var_name = 'riverflow'
+    CALL ioconf_setatt('UNITS', 'Kg/dt')
+    CALL ioconf_setatt('LONG_NAME','River flux into the sea')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., riverflow_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (riverflow_mean, val_exp, 'NO_KEYWORD', zero)
+    riverflow(:) = riverflow_mean(:)
+    !
+    ALLOCATE (coastalflow_mean(nbpt))
+    var_name = 'coastalflow'
+    CALL ioconf_setatt('UNITS', 'Kg/dt')
+    CALL ioconf_setatt('LONG_NAME','Diffuse flux into the sea')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., coastalflow_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (coastalflow_mean, val_exp, 'NO_KEYWORD', zero)
+    coastalflow(:) = coastalflow_mean(:)
+    !
+    ! 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))
+    var_name = 'hydrographs'
+    CALL ioconf_setatt('UNITS', 'm^3/dt')
+    CALL ioconf_setatt('LONG_NAME','Hydrograph at outlow of grid')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 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), slow_diag(nbpt), stream_diag(nbpt), lake_diag(nbpt), stat=ier)
+    !
+    fast_diag(:) = zero
+    slow_diag(:) = zero
+    stream_diag(:) = zero
+    lake_diag(:) = zero
+    !
+    DO ig=1,nbpt
+       totarea = zero
+       DO ib=1,nbasmax
+          totarea = totarea + routing_area(ig,ib)
+          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)
+       ENDDO
+       !
+       fast_diag(ig) = fast_diag(ig)/totarea
+       slow_diag(ig) = slow_diag(ig)/totarea
+       stream_diag(ig) = stream_diag(ig)/totarea
+       !
+       ! 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)/totarea
+       !
+    ENDDO
+    !
+    !
+    ! Get from the restart the fluxes we accumulated.
+    !
+    ALLOCATE (runoff_mean(nbpt))
+    var_name = 'runoff_route'
+    CALL ioconf_setatt('UNITS', 'Kg')
+    CALL ioconf_setatt('LONG_NAME','Accumulated runoff for routing')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., runoff_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (runoff_mean, val_exp, 'NO_KEYWORD', zero)
+    !
+    ALLOCATE(drainage_mean(nbpt))
+    var_name = 'drainage_route'
+    CALL ioconf_setatt('UNITS', 'Kg')
+    CALL ioconf_setatt('LONG_NAME','Accumulated drainage for routing')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., drainage_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (drainage_mean, val_exp, 'NO_KEYWORD', zero)
+    !
+    ALLOCATE(evapot_mean(nbpt))
+    var_name = 'evapot_route'
+    CALL ioconf_setatt('UNITS', 'Kg/m^2')
+    CALL ioconf_setatt('LONG_NAME','Accumulated potential evaporation for routing')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evapot_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (evapot_mean, val_exp, 'NO_KEYWORD', zero)
+    !
+    ALLOCATE(precip_mean(nbpt))
+    var_name = 'precip_route'
+    CALL ioconf_setatt('UNITS', 'Kg/m^2')
+    CALL ioconf_setatt('LONG_NAME','Accumulated rain precipitation for irrigation')
+    CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., precip_mean, "gather", nbp_glo, index_g)
+    CALL setvar_p (precip_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(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),hydrodiag_glo(nbp_glo,nbasmax),stat=ier)
+    IF (ier.NE.0) THEN
+        WRITE (numout,*) ' error in hydrodiag allocation. We stop. We need kjpindex words = ', nbpt*nbasmax
+        STOP 'routing_init'
+    END IF
+
+    hydrodiag=>hydrodiag_loc
+    !
+    !
+  END SUBROUTINE routing_init
+  !
+  !---------------------------------------------------------------------------------
+  !
+  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(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(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(lake_reservoir)) DEALLOCATE(lake_reservoir)
+    IF (ALLOCATED(returnflow_mean)) DEALLOCATE(returnflow_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(drainage_mean)) DEALLOCATE(drainage_mean)
+    IF (ALLOCATED(evapot_mean)) DEALLOCATE(evapot_mean)
+    IF (ALLOCATED(precip_mean)) DEALLOCATE(precip_mean)
+    IF (ALLOCATED(humrel_mean)) DEALLOCATE(humrel_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(hydrographs)) DEALLOCATE(hydrographs)
+    IF (ALLOCATED(irrigation_mean)) DEALLOCATE(irrigation_mean)
+    IF (ALLOCATED(irrigated)) DEALLOCATE(irrigated)
+    IF (ALLOCATED(floodplains)) DEALLOCATE(floodplains)
+    !
+  END SUBROUTINE routing_clear
+  !
+  !---------------------------------------------------------------------------------
+  !
+  SUBROUTINE routing_flow(nbpt, dt_routing, runoff, drainage, &
+       &                  vegtot, totnobio, evapot, precip, humrel, floodtemp, &
+       &                  lakeinflow, returnflow, irrigation, riverflow, &
+       &                  coastalflow, hydrographs)
+    !
+    IMPLICIT NONE
+    !
+    !
+    !  INPUT
+    !
+    INTEGER(i_std), INTENT(in)    :: nbpt                !! Domain size
+    REAL(r_std), INTENT (in)      :: dt_routing          !! Time step in seconds
+    REAL(r_std), INTENT(in)       :: runoff(nbpt)        !! grid-point runoff
+    REAL(r_std), INTENT(in)       :: drainage(nbpt)      !! grid-point drainage
+    REAL(r_std), INTENT(in)       :: vegtot(nbpt)        !! Potentially vegetated area
+    REAL(r_std), INTENT(in)       :: totnobio(nbpt)      !! Other areas whichcan not have vegetation
+    REAL(r_std), INTENT(in)       :: evapot(nbpt)        !! grid-point potential evaporation
+    REAL(r_std), INTENT(in)       :: precip(nbpt)        !! Precipiation (rainfall here)
+    REAL(r_std), INTENT(in)       :: humrel(nbpt)        !! Soil moisture stress
+    REAL(r_std), INTENT(in)       :: floodtemp(nbpt)     !! Temperature to decide if floodplains work
+    REAL(r_std), INTENT(out)      :: lakeinflow(nbpt)    !! The water flow which flows into lakes (kg/dt)
+    REAL(r_std), INTENT(out)      :: returnflow(nbpt)    !! Water flowing back into soil moisture (kg/m^2/dt)
+    REAL(r_std), INTENT(out)      :: irrigation(nbpt)    !! The artificial irrigation (kg/m^2 per dt) 
+    REAL(r_std), INTENT(out)      :: riverflow(nbpt)     !! Outflow of the major rivers (kg/dt)
+    REAL(r_std), INTENT(out)      :: coastalflow(nbpt)   !! Outflow on coastal points by small basins (kg/dt) 
+    REAL(r_std), INTENT(out)      :: hydrographs(nbpt)   !! Hydrographs at the outflow of the gird box for major basins   
+    !
+    ! LOCAL
+    !
+    REAL(r_std), DIMENSION(nbpt, nbasmax)   :: fast_flow
+    REAL(r_std), DIMENSION(nbpt, nbasmax)   :: slow_flow
+    REAL(r_std), DIMENSION(nbpt, nbasmax)   :: stream_flow
+    REAL(r_std), DIMENSION(nbpt, nbasmax)   :: reinfiltration
+    REAL(r_std), DIMENSION(nbpt, nbasmax)   :: baseirrig      !! Irrigation uptake from each basin reservoir.
+    REAL(r_std), DIMENSION(nbpt, 0:nbasmax+3) :: transport
+    REAL(r_std), DIMENSION(nbp_glo, 0:nbasmax+3) :: transport_glo
+    REAL(r_std), DIMENSION(nbp_glo, 0:nbasmax+3) :: transport_sum
+    REAL(r_std), DIMENSION(nbpt, nbasmax)   :: floods, wdelay, previous_outflow, potflood, inflow
+    REAL(r_std), DIMENSION(nbpt)            :: tobeflooded
+    REAL(r_std), DIMENSION(nbpt)            :: totarea
+    REAL(r_std)                             :: flow, floodindex
+    INTEGER(i_std) :: ig, ib, rtg, rtb, ierr
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: fast_flow_g,slow_flow_g,stream_flow_g,floods_g,wdelay_g
+
+    !
+    transport(:,:) = zero
+    transport_glo(:,:) = zero
+    previous_outflow(:,:) = zero
+    irrig_netereq(:) = zero
+    baseirrig(:,:) = zero
+    totarea(:) = zero
+    !
+    ! Compute all the fluxes
+    !
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+          !
+          totarea(ig) = totarea(ig) + routing_area(ig,ib)
+          !
+          IF ( route_tobasin(ig,ib) .GT. 0 ) THEN
+             !
+             flow = MIN(fast_reservoir(ig,ib)/((topo_resid(ig,ib)/1000.)*fast_tcst*one_day/dt_routing),&
+                  & fast_reservoir(ig,ib))
+             fast_flow(ig,ib) = flow
+             !
+             flow = MIN(slow_reservoir(ig,ib)/((topo_resid(ig,ib)/1000.)*slow_tcst*one_day/dt_routing),&
+                  & slow_reservoir(ig,ib))
+             slow_flow(ig,ib) = flow
+             !
+             flow = MIN(stream_reservoir(ig,ib)/((topo_resid(ig,ib)/1000.)*stream_tcst*one_day/dt_routing),&
+                  & stream_reservoir(ig,ib))
+             stream_flow(ig,ib) = flow
+             ! 
+             !
+          ELSE
+             fast_flow(ig,ib) = zero
+             slow_flow(ig,ib) = zero
+             stream_flow(ig,ib) = zero
+          ENDIF
+          inflow(ig,ib) = fast_flow(ig,ib) + slow_flow(ig,ib) + stream_flow(ig,ib)
+       ENDDO
+    ENDDO
+    !
+    ! Do the floodings
+    !
+    IF ( dofloodplains ) THEN
+       DO ig=1,nbpt
+          tobeflooded(ig) = floodplains(ig)
+          DO ib=1,nbasmax
+             potflood(ig,ib) = inflow(ig,ib) - previous_outflow(ig,ib)
+             !
+             IF ( tobeflooded(ig) > 0. .AND. potflood(ig,ib) > zero .AND. floodtemp(ig) > tp_00 ) THEN
+                !
+                IF (routing_area(ig,ib) > tobeflooded(ig)) THEN
+                   floodindex = tobeflooded(ig) / routing_area(ig,ib)
+                   ELSE
+                      floodindex = un
+                ENDIF
+                !
+                floods(ig,ib) = floodindex * evap_cst * potflood(ig,ib)
+                !
+                wdelay(ig,ib) = floodindex * wdelay_cst * potflood(ig,ib)
+                !
+                !
+                tobeflooded(ig) = tobeflooded(ig) - routing_area(ig,ib) 
+                !
+                ELSE
+                   floods(ig,ib) = zero
+                   wdelay(ig,ib) = zero
+             ENDIF
+          ENDDO
+       ENDDO
+    ELSE
+       DO ig=1,nbpt
+          DO ib=1,nbasmax
+             floods(ig,ib) = zero
+             wdelay(ig,ib) = zero
+          ENDDO
+       ENDDO
+    ENDIF
+    !
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+        reinfiltration(ig,ib) = floods(ig,ib)    
+      ENDDO
+    ENDDO
+
+!ym cette methode conserve les erreurs d'arrondie
+!ym mais n'est pas la plus efficace
+
+    IF (is_root_prc)  THEN
+       ALLOCATE( fast_flow_g(nbp_glo, nbasmax), slow_flow_g(nbp_glo, nbasmax), &
+            stream_flow_g(nbp_glo, nbasmax), floods_g(nbp_glo, nbasmax),  &
+            wdelay_g(nbp_glo, nbasmax) )
+    ELSE
+       ALLOCATE( fast_flow_g(1,1), slow_flow_g(1,1), &
+            stream_flow_g(1, 1), floods_g(1,1),  &
+            wdelay_g(1,1) )
+    ENDIF
+    
+       
+    CALL gather(fast_flow,fast_flow_g)
+    CALL gather(slow_flow,slow_flow_g)
+    CALL gather(stream_flow,stream_flow_g)
+    CALL gather(floods,floods_g)
+    CALL gather(wdelay,wdelay_g)
+
+    IF (is_root_prc) THEN
+       DO ig=1,nbp_glo
+          DO ib=1,nbasmax
+             !
+             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) - floods_g(ig,ib) - wdelay_g(ig,ib)
+             !
+          ENDDO
+       ENDDO
+    ENDIF
+
+    DEALLOCATE( fast_flow_g, slow_flow_g, stream_flow_g, floods_g, wdelay_g )
+   
+    CALL scatter(transport_glo,transport)
+
+!ym    DO ig=1,nbpt
+!ym       DO ib=1,nbasmax
+!ym          !
+!ym          rtg = route_togrid(ig,ib)
+!ym          rtb = route_tobasin(ig,ib)
+!ym          transport_glo(rtg,rtb) = transport_glo(rtg,rtb) + fast_flow(ig,ib) + slow_flow(ig,ib) + &
+!ym               & stream_flow(ig,ib) - floods(ig,ib) - wdelay(ig,ib)
+!ym          !
+!ym       ENDDO
+!ym    ENDDO
+!ym    
+!ym    CALL reduce_sum(transport_glo,transport_sum)
+!ym    CALL scatter(transport_sum,transport)
+    
+    !
+    ! Update all reservoirs
+    !
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+          fast_reservoir(ig,ib) =  fast_reservoir(ig,ib) + runoff(ig)*routing_area(ig,ib) - &
+               & reinfiltration(ig,ib) - fast_flow(ig,ib) + floods(ig,ib) + wdelay(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) + transport(ig,ib) - &
+               & stream_flow(ig,ib)
+          !
+          previous_outflow(ig,ib) = fast_flow(ig,ib) + slow_flow(ig,ib) + stream_flow(ig,ib) - & 
+               &  wdelay(ig,ib) - floods(ig,ib)
+          !
+       ENDDO
+    ENDDO
+    !
+    ! Compute the total reinfiltration in the grid box
+    !
+    returnflow(:) = zero
+    DO ig=1,nbpt
+       !
+       DO ib=1,nbasmax
+          returnflow(ig) =  returnflow(ig) + reinfiltration(ig,ib)
+       ENDDO
+       !
+       returnflow(ig) = returnflow(ig)/totarea(ig)
+       !
+    ENDDO
+    !
+    ! 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.
+    !
+    IF ( doirrigation ) THEN
+       DO ig=1,nbpt
+          
+          IF ((vegtot(ig) .GT. zero) .AND. (humrel(ig) .LT. 0.99)) THEN
+             irrig_netereq(ig) = (irrigated(ig) / totarea(ig) ) * MAX(zero, &
+                  & crop_coef * evapot(ig) - &
+                  & MAX(precip(ig)+returnflow(ig)-runoff(ig)-drainage(ig), zero) )
+             irrig_netereq(ig) = 1 * irrig_netereq(ig)
+             
+             IF(irrig_netereq(ig).LT.zero) THEN
+                WRITE(numout,*) 'there is a probleme for irrig_netereq',ig,irrig_netereq(ig)
+             ENDIF
+             
+          ENDIF
+
+          DO ib=1,nbasmax
+             IF ( route_tobasin(ig,ib) .GT. 0 ) THEN
+
+                baseirrig(ig,ib) = MIN( irrig_netereq(ig) * routing_area(ig,ib),&
+                     &   stream_reservoir(ig,ib) + fast_reservoir(ig,ib) + slow_reservoir(ig,ib) )
+                
+                slow_reservoir(ig,ib) = MAX(zero, slow_reservoir(ig,ib) + &
+                     & MIN(zero, fast_reservoir(ig,ib) + MIN(zero, stream_reservoir(ig,ib)-baseirrig(ig,ib))))
+
+                fast_reservoir(ig,ib) = MAX( zero, &
+                     &  fast_reservoir(ig,ib) + MIN(zero, stream_reservoir(ig,ib)-baseirrig(ig,ib)))
+                stream_reservoir(ig,ib) = MAX(zero, stream_reservoir(ig,ib)-baseirrig(ig,ib) )
+
+                IF(baseirrig(ig,ib) .LT. zero .OR. slow_reservoir(ig,ib) .LT. zero .OR. &
+                     & fast_reservoir(ig,ib) .LT. zero .OR. stream_reservoir(ig,ib) .LT. zero) THEN
+                   WRITE(numout,*) 'There is negative values related to irrigation', ig,ib,baseirrig(ig,ib), &
+                        & slow_reservoir(ig,ib),fast_reservoir(ig,ib),stream_reservoir(ig,ib)
+                ENDIF
+
+             ENDIF
+             
+             previous_outflow(ig,ib) = fast_flow(ig,ib) + slow_flow(ig,ib) + stream_flow(ig,ib) - &
+                  &  wdelay(ig,ib) - floods(ig,ib)
+             
+          ENDDO
+       ENDDO
+       !
+    ENDIF
+    !
+    !
+    ! Compute the fluxes which leave the routing scheme
+    !
+    ! Lakeinflow is in Kg/dt
+    ! returnflow is in Kg/m^2/dt
+    !
+    hydrographs(:) = zero
+    fast_diag(:) = zero
+    slow_diag(:) = zero
+    stream_diag(:) = zero
+    irrigation(:) = zero
+    !
+    !
+    DO ig=1,nbpt
+       !
+       DO ib=1,nbasmax
+          IF (hydrodiag(ig,ib) > 0 ) THEN
+             hydrographs(ig) = hydrographs(ig) + fast_flow(ig,ib) + slow_flow(ig,ib) + & 
+           &  stream_flow(ig,ib) - floods(ig,ib) - wdelay(ig,ib) 
+          ENDIF
+          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)
+          irrigation (ig) = irrigation (ig) + baseirrig(ig,ib)
+       ENDDO
+       !
+       fast_diag(ig) = fast_diag(ig)/totarea(ig)
+       slow_diag(ig) = slow_diag(ig)/totarea(ig)
+       stream_diag(ig) = stream_diag(ig)/totarea(ig)
+       !
+       irrigation(ig) = irrigation(ig)/totarea(ig)
+       !
+       ! 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)
+       !
+       IF ( irrigation(ig) .GE. irrig_netereq(ig)+1e4 ) THEN
+          WRITE(numout,*) 'There is a problem here with irrigation',ig,irrigation(ig),irrig_netereq(ig)
+          WRITE(numout,*) irrigated(ig),totarea(ig), evapot(ig), precip_mean(ig),runoff(ig),drainage(ig)
+          STOP
+       ENDIF
+       !
+    ENDDO
+    !
+  END SUBROUTINE routing_flow
+  !
+  !---------------------------------------------------------------------------------
+  !
+  SUBROUTINE routing_lake(nbpt, dt_routing, lakeinflow, humrel, returnflow)
+    !
+    IMPLICIT NONE
+    !
+    ! This routine 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.
+    ! The return flow to the soil moisture reservoir is based on a maximum
+    ! lake evaporation rate (maxevap_lake).
+    !
+    INTEGER(i_std), INTENT(in)    :: nbpt                !! Domain size
+    REAL(r_std), INTENT (in)      :: dt_routing          !! Time step in seconds
+    REAL(r_std), INTENT(in)       :: lakeinflow(nbpt)    !! Flow into the lake (kg/dt)
+    REAL(r_std), INTENT(in)       :: humrel(nbpt)        !! Soil moisture deficit around the lake (Hum !)
+    REAL(r_std), INTENT(out)      :: returnflow(nbpt)    !! Water flowing back into soil moisture (kg/m^2/dt)
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std)                :: ig
+    REAL(r_std)                   :: refill, total_area
+    !
+    !
+    !
+    DO ig=1,nbpt
+       !
+       total_area = SUM(routing_area(ig,:))
+       !
+       lake_reservoir(ig) = lake_reservoir(ig) + lakeinflow(ig)
+       !uptake in Kg/dt
+       refill = MAX(zero, maxevap_lake * (un - humrel(ig)) * dt_routing * total_area)
+       returnflow(ig) = MIN(refill, lake_reservoir(ig))
+       lake_reservoir(ig) = lake_reservoir(ig) - returnflow(ig)
+       !Return in Kg/m^2/dt
+       returnflow(ig) = returnflow(ig)/total_area
+       !
+       ! 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
+    !
+  END SUBROUTINE routing_lake
+  !
+  !---------------------------------------------------------------------------------
+  !
+  SUBROUTINE routing_diagnostic_p(nbpt,index, resolution, contfrac, hist_id, hist2_id)
+    !
+    IMPLICIT NONE
+    
+    INTEGER(i_std), INTENT(in)    :: nbpt                !! Domain size
+    INTEGER(i_std), INTENT(in)    :: index(nbpt)         !! Indeces of the points on the map 
+    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)    :: hist_id             !! _history_ file identifier  
+    INTEGER(i_std),INTENT (in)    :: hist2_id            !! _history_ file 2 identifier
+    REAL(r_std), DIMENSION(nbpt)        :: nbrivers    !! Number of rivers in the grid
+    REAL(r_std), DIMENSION(nbpt)        :: basinmap    !! Map of basins
+    REAL(r_std), DIMENSION(nbp_glo)        :: nbrivers_g    !! Number of rivers in the grid
+    REAL(r_std), DIMENSION(nbp_glo)        :: basinmap_g    !! Map of basins
+
+    routing_area => routing_area_glo  
+    topo_resid => topo_resid_glo
+    route_togrid => route_togrid_glo
+    route_tobasin => route_tobasin_glo
+    global_basinid => global_basinid_glo
+    hydrodiag=>hydrodiag_glo
+    
+    IF (is_root_prc) CALL routing_diagnostic(nbp_glo,index_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
+    global_basinid => global_basinid_loc
+    hydrodiag=>hydrodiag_loc
+    
+    CALL scatter(nbrivers_g,nbrivers)
+    CALL scatter(basinmap_g,basinmap)
+    CALL scatter(hydrodiag_glo,hydrodiag_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(nbpt,index, resolution, contfrac,nbrivers,basinmap)
+    !
+    ! This subroutine will set up a map of the major basins
+    !
+    !  INPUTS
+    !
+    INTEGER(i_std), INTENT(in)    :: nbpt                !! Domain size
+    INTEGER(i_std), INTENT(in)    :: index(nbpt)         !! Indeces of the points on the map 
+    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.
+    !
+    !  OUTPUTS
+    !
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)        :: nbrivers    !! Number of rivers in the grid
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)        :: basinmap    !! Map of basins
+    !
+    !  LOCAL
+    !
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: pts         !! list the points belonging to the basin
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: ptbas       !! list the basin number for this point
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: outpt       !! Outflow point for each basin
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: nb_pts      !! Number of points in the basin
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)        :: totarea     !! Total area of basin
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: topids      !! The IDs of the first num_largest basins.
+    CHARACTER(LEN=25), ALLOCATABLE, DIMENSION(:) :: basin_names !! Names of the rivers
+    CHARACTER(LEN=25)                            :: name_str
+    !
+    INTEGER(i_std) :: ig, ib, og, ob, ign, ibn, ff(1), ic, icc, nb_small
+    !
+    ALLOCATE(pts(num_largest, nbpt))
+    ALLOCATE(ptbas(num_largest, nbpt))
+    ALLOCATE(outpt(num_largest, 2))
+    ALLOCATE(nb_pts(num_largest))
+    ALLOCATE(totarea(num_largest))
+    ALLOCATE(topids(num_largest))
+    !
+    !
+    ! 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
+    DO ig=1,nbpt
+       DO ib=1,nbasmax
+          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)
+          ENDDO
+          !
+          ! 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.
+                   !
+                   IF ( routing_area(ig,ib) .GT. 0.25*resolution(ig,1)*resolution(ig,2)*contfrac(ig) ) THEN
+                      nb_pts(icc) = nb_pts(icc) + 1
+                      pts(icc, nb_pts(icc)) = ig
+                      ptbas(icc, nb_pts(icc)) = ib
+                   ENDIF
+                   totarea(icc) = totarea(icc) + routing_area(ig,ib)
+                   ! ID of the river is taken from the last point before the outflow.
+                   topids(icc) = global_basinid(og,ob)
+                   !
+                   ! On this gridbox and basin we will diagnose the hydrograph
+                   !
+                   hydrodiag(ig, ib) = 1
+                   !
+                ENDIF
+             ENDDO
+          ENDIF
+
+       ENDDO
+    ENDDO
+    !
+    ! Construct the map of the largest basins. We take the num_largest basins
+    ! if they have more than 4 points. After that it is of no use.
+    !
+    !
+    basinmap(:) = zero
+    DO icc = 1, num_largest
+       ff = MAXLOC(totarea)   
+       IF ( nb_pts(ff(1)) .GT. 2 ) THEN
+          DO ig = 1, nb_pts(ff(1))
+             basinmap(pts(ff(1),ig)) = REAL(icc,r_std)
+          ENDDO
+          !
+          IF ( topids(ff(1)) .GT. nb_small ) THEN
+             WRITE(name_str, '("NN, Nb : ",I4)') topids(ff(1))
+          ELSE
+             name_str = basin_names(topids(ff(1)))
+          ENDIF
+          !
+          WRITE(numout,&
+               '("Basin ID ", I5," ", A15, " Area [km^2] : ", F13.4, " Nb points : ", I4)')&
+               & topids(ff(1)), name_str(1:15), totarea(ff(1))/1.e6,  nb_pts(ff(1))
+       ENDIF
+       totarea(ff(1)) = zero
+    ENDDO
+    !
+    !
+    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)
+    !
+  END SUBROUTINE routing_diagnostic
+  !
+  !---------------------------------------------------------------------------------
+  !
+  SUBROUTINE routing_basins_p(nbpt, lalo, neighbours, resolution, contfrac)
+    !
+    IMPLICIT NONE
+    !
+    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)    :: 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
+    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
+    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(global_basinid_glo,global_basinid_loc)
+    
+  END SUBROUTINE routing_basins_p
+  
+  SUBROUTINE routing_basins(nbpt, lalo, neighbours, resolution, contfrac)
+    !
+    IMPLICIT NONE
+    !
+    !
+    !  This subroutine reads in the map of basins and flow direction to construct the
+    !  the catchments of each grid box.
+    !
+    !  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 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 global fields.
+    !  Then we work on the global grid to perform the following tasks :
+    !  1) We linkup the basins of the various and check the global consistence.
+    !  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.
+    !
+    !
+    !  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=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.
+    !
+    !
+    !  0.3 LOCAL
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, fopt, lastjp, nbexp
+    REAL(r_std) :: lev(1), date, dt, coslat, pi
+    INTEGER(i_std) :: itau(1), sgn
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: trip, basins, topoindex, hierarchy
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_rel, lon_rel, lat_ful, lon_ful
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: loup_rel, lolow_rel, laup_rel, lalow_rel
+    REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
+    !
+    INTEGER(i_std) :: nbi, nbj
+    REAL(r_std)    :: ax, ay, min_topoind, max_basins, invented_basins
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: sub_pts
+    REAL(r_std), DIMENSION(nbvmax,nbvmax) :: area_bx, hierarchy_bx, lon_bx, lat_bx, topoind_bx
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax) ::  trip_bx, basin_bx
+    !
+    INTEGER(i_std) :: coast_pts(nbvmax)
+    REAL(r_std) :: lonrel, louprel, lolowrel
+    !
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: basin_count
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_id
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: basin_area, basin_hierarchy, basin_topoind
+    REAL(r_std),  ALLOCATABLE, DIMENSION(:,:)     :: fetch_basin
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: basin_flowdir
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: outflow_grid
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: outflow_basin
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: inflow_number
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: inflow_basin, inflow_grid
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)     :: nbcoastal
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: coastal_basin
+
+    !
+    INTEGER(i_std) :: nb_basin, nwbas
+    INTEGER(i_std) :: basin_inbxid(nbvmax), basin_sz(nbvmax), basin_pts(nbvmax,nbvmax,2), basin_bxout(nbvmax)
+    CHARACTER(LEN=7)   :: fmt
+    LOGICAL       :: debug = .FALSE.
+    INTEGER(i_std), DIMENSION(2) :: diagbox = (/ 1147, 1148 /) 
+
+    ! Test on diagbox and nbpt
+    IF (debug) THEN
+       IF (ANY(diagbox .GT. nbpt)) THEN 
+          WRITE(*,*) "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
+    !
+    pi = 4. * ATAN(1.)
+    !
+    !  Needs to be a configurable variable
+    !
+    !
+    !Config Key  = ROUTING_FILE
+    !Config Desc = Name of file which contains the routing information
+    !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.
+    !
+    filename = 'routing.nc'
+    CALL getin('ROUTING_FILE',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 (trip(iml,jml))
+    ALLOCATE (basins(iml,jml))
+    ALLOCATE (topoindex(iml,jml))
+    ALLOCATE (hierarchy(iml,jml))
+    !
+    ALLOCATE (sub_area(nbpt,nbvmax))
+    ALLOCATE (sub_index(nbpt,nbvmax,2))
+    ALLOCATE (sub_pts(nbpt))
+    !
+
+    !
+    CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
+    !
+    ! 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)
+    ! trip = 99 : river flow into the oceans
+    !
+    !
+    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)
+    !
+    nbexp = 0
+    !
+    min_topoind = MINVAL(topoindex, MASK=topoindex .LT. undef_sechiba-un)
+    !
+    DO ip=1,iml
+       DO jp=1,jml
+          IF ( trip(ip,jp) .LT. 1.e10 .AND. topoindex(ip,jp) .GT. 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
+    !
+    !    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 = INT(lat_rel(1,1)/ABS(lat_rel(1,1)))
+    lat_ful(2:iml+1,1) = sgn*180 - lat_rel(1:iml,1)
+    sgn = INT(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. ), 0.001 )*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 = 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.
+          !
+          !  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
+                   !
+                   !  Is it a land point ?
+                   !
+                   IF (trip(ip,jp) .LT. 1.e10) THEN
+                      !
+                      fopt = fopt + 1
+                      IF ( fopt .GT. nbvmax) THEN
+                         WRITE(numout,*) 'Please increase nbvmax in subroutine routing_basins', ib
+                         STOP
+                      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( 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. ), 0.001 )
+                         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
+                         sub_area(ib, fopt) = ax*ay
+                         sub_index(ib, fopt, 1) = ip
+                         sub_index(ib, fopt, 2) = jp
+                      ENDIF
+                   ENDIF
+                   !
+                   sub_pts(ib) = fopt
+                   !
+                ENDIF
+                !
+             ENDDO
+             !
+          ENDIF
+          !
+       ENDDO
+       !
+       !
+    ENDDO
+    !
+    ! Do some memory management.
+    !
+    DEALLOCATE (laup_rel)
+    DEALLOCATE (loup_rel)
+    DEALLOCATE (lalow_rel)
+    DEALLOCATE (lolow_rel)
+    DEALLOCATE (lat_ful)
+    DEALLOCATE (lon_ful)
+    !
+    nwbas = MAXVAL(sub_pts)
+    !
+    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
+    !
+    CALL routing_hierarchy(iml, jml, trip, topoindex, hierarchy)
+    !
+    !
+    DO ib =1, nbpt
+       !
+       !
+       !  extract the information for this 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)
+       !
+       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 coatal flow
+       !
+       IF ( debug .AND. (COUNT(diagbox .EQ. ib) .GT. 0) ) THEN
+          WRITE(numout,*) '===================== IB = :', ib
+          WRITE(numout,*) "sub_pts(ib) :", sub_pts(ib)
+          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
+       !
+       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
+    !
+    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
+    !
+    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."
+    !
+    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)
+    !
+    DEALLOCATE (lat_rel)
+    DEALLOCATE (lon_rel)
+    !
+    DEALLOCATE (trip)
+    DEALLOCATE (basins)
+    DEALLOCATE (topoindex)
+    DEALLOCATE (hierarchy)
+    !
+    DEALLOCATE (sub_area)
+    DEALLOCATE (sub_index)
+    DEALLOCATE (sub_pts)
+    !
+    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(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
+    !
+    ! Extracts from the global high resolution fileds the data for the current grid box
+    ! we are dealing with.
+    !
+    ! 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).
+    !
+    !  INPUT
+    !
+    INTEGER(i_std), INTENT(in) :: nbpt              ! Number of points in the global grid
+    INTEGER(i_std), INTENT(in) :: iml, jml          ! Resolution of the high resolution grid
+    INTEGER(i_std), INTENT(in) :: ib                ! point we are currently dealing with
+    INTEGER(i_std), INTENT(in) :: sub_pts(nbpt)     ! Number of high resiolution points on this grid
+    INTEGER(i_std), INTENT(in) :: sub_index(nbpt, nbvmax,2) ! indeces of the points we need on the fine grid
+    REAL(r_std), INTENT(inout) :: max_basins        ! The current maximum of basins
+    REAL(r_std), INTENT(in)    :: min_topoind       ! The current maximum of topographic index
+    REAL(r_std), INTENT(in)    :: sub_area(nbpt, nbvmax)    ! area on the fine grid
+    REAL(r_std), INTENT(in)    :: lon_rel(iml, jml), 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 in km of each grid-box in X and Y
+    REAL(r_std), INTENT(in)    :: contfrac(nbpt)     ! Fraction of land in each grid box.
+    REAL(r_std), INTENT(inout) :: trip(iml, jml), basins(iml, jml)     ! data on the fine grid
+    REAL(r_std), INTENT(inout) :: topoindex(iml, jml), hierarchy(iml, jml) ! data on the fine grid
+    INTEGER(i_std), INTENT(out):: nbi, nbj           ! Number of point ion x and y within the grid
+    REAL(r_std), INTENT(out)   :: area_bx(nbvmax,nbvmax), hierarchy_bx(nbvmax,nbvmax)
+    REAL(r_std), INTENT(out)   :: lon_bx(nbvmax,nbvmax), lat_bx(nbvmax,nbvmax), topoind_bx(nbvmax,nbvmax)
+    INTEGER(i_std), INTENT(out):: trip_bx(nbvmax,nbvmax), basin_bx(nbvmax,nbvmax)
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: ip, jp, ll(1), iloc, jloc
+    REAL(r_std)    :: lonstr(nbvmax*nbvmax), 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(nb_in, coords, direction, nb_out)
+    !
+    IMPLICIT NONE
+    !
+    ! Input/Output
+    !
+    INTEGER(i_std), INTENT(in)                    :: nb_in
+    REAL(r_std), INTENT(inout)                    :: coords(nb_in)
+    CHARACTER(LEN=2)                             :: direction
+    INTEGER(i_std), INTENT(out)                   :: nb_out
+    !
+    ! Local
+    !
+    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(nbi, nbj, trip, basin, hierarchy, topoind, nb_basin, basin_inbxid, basin_sz,&
+       & basin_bxout, basin_pts, coast_pts)
+    !
+    IMPLICIT NONE
+    !
+    !  This subroutine find 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.
+    !  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
+    ! -------------------
+    ! Inside of the box :
+    ! 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
+    !
+    ! Out flow from the gird :
+    ! 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
+    !
+    !  Inputs
+    !
+    INTEGER(i_std) :: nbi, nbj
+    INTEGER(i_std) :: trip(:,:), basin(:,:)
+    REAL(r_std)    :: hierarchy(:,:), topoind(:,:)
+    !
+    !  Outputs
+    !
+    INTEGER(i_std) :: nb_basin
+    INTEGER(i_std) :: basin_inbxid(nbvmax), basin_sz(nbvmax), basin_bxout(nbvmax)
+    INTEGER(i_std) :: basin_pts(nbvmax, nbvmax, 2)
+    INTEGER(i_std) :: coast_pts(nbvmax)
+    !
+    !  Local
+    !
+    INTEGER(i_std) :: ibas, ilf, nbb, nb_in
+    INTEGER(i_std) :: bname(nbvmax), sz(nbvmax), pts(nbvmax,nbvmax,2), nbout(nbvmax)
+    INTEGER(i_std) :: new_nb, new_bname(nbvmax), new_sz(nbvmax), new_pts(nbvmax,nbvmax,2)
+    INTEGER(i_std) :: itrans, trans(nbvmax), 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
+    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(nbi, nbj, trip, basin, hierarchy, basin_inbxid)
+    !
+    IMPLICIT NONE
+    !
+    !  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. But here we will not change the
+    !  the direction of the outflow.
+    !
+    !  Inputs
+    INTEGER(i_std) :: nbi, nbj
+    INTEGER(i_std) :: trip(:,:), basin(:,:)
+    REAL(r_std)    :: hierarchy(:,:)
+    INTEGER(i_std) :: basin_inbxid
+    !
+    !  Local
+    !
+    INTEGER(i_std) :: ip, jp, nbout, basin_sz, iborder
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax) :: trip_tmp
+    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
+    INTEGER(i_std), DIMENSION(nbvmax) :: todopt, todosz
+    REAL(r_std), DIMENSION(nbvmax)    :: todohi
+    LOGICAL                          :: not_found, debug = .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 smalest 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 (nbi, nbj, nbbasins, trip, basin, basin_inbxid, nb, bname, sz, pts)
+    !
+    IMPLICIT NONE
+    !
+    !  This subroutine cuts the original basin which has more than one outflow into as
+    !  many subbasins as outflow directions.
+    !
+    !  Inputs
+    INTEGER(i_std) :: nbi, nbj
+    INTEGER(i_std) :: nbbasins
+    INTEGER(i_std) :: trip(:,:), basin(:,:)
+    INTEGER(i_std) :: basin_inbxid
+    !
+    !  Outputs
+    !
+    INTEGER(i_std) :: nb, bname(nbvmax), sz(nbvmax), pts(nbvmax,nbvmax,2)
+    !
+    !  Local
+    !
+    INTEGER(i_std) :: ip, jp, iip, jjp, ib, ibb, id, nbout
+    INTEGER(i_std) :: basin_sz, nb_in
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax) :: trip_tmp
+    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, debug=.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(iml, jml, trip, topoindex, hierarchy)
+    !
+    IMPLICIT NONE
+    !
+    !  This subroutine will find for each point the distance to the outflow point
+    !  along the flowlines of the basin.
+    !
+    INTEGER(i_std) :: iml, jml
+    REAL(r_std), DIMENSION(iml,jml) :: trip, hierarchy, topoindex
+    !
+    INTEGER(i_std), DIMENSION(8,2) :: inc
+    INTEGER(i_std)                 :: ip, jp, ib, ntripi, ntripj, cnt, trp
+    REAL(r_std)                    :: topohier, topohier_old
+    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 = 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 = 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(nbi, nbj, trip, basin_sz, basinid, nbout, outflow, trip_flow, outsz)
+    !
+    IMPLICIT NONE
+    !
+    ! This subroutine simply computes the route to each outflow point and returns
+    ! the outflow point for each point in the basin.
+    !
+    ! INPUT
+    !
+    INTEGER(i_std)                             :: nbi, nbj
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)   :: trip
+    INTEGER(i_std)                             :: basin_sz, basinid, nbout
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax,2) :: trip_flow
+    INTEGER(i_std), DIMENSION(nbvmax,2)        :: outflow
+    INTEGER(i_std), DIMENSION(nbvmax)          :: outsz
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std), DIMENSION(8,2) :: inc
+    INTEGER(i_std)                 :: ip, jp, ib, cnt, trp, totsz
+    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(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
+    !
+    !  This subroutine will put the basins found for grid-box in in the global map. Connection can
+    !  only be made later when all information is together.
+    !
+    !
+    !  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
+    !  and -1 river flow.
+    !
+    !  LOCAL
+    ! 
+    INTEGER(i_std), INTENT (in)               :: nbpt, ib            ! Current grid-box
+    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), DIMENSION(nbvmax,nbvmax)     :: area_bx             ! Area of each small box in the grid-box
+    INTEGER(i_std), DIMENSION(nbvmax,nbvmax)  :: trip_bx             ! The trip field for each of the smaler boxes
+    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
+    REAL(r_std)                               :: min_topoind        ! The default topographic index
+    INTEGER(i_std)                            :: nb_basin            ! number of sub-basins
+    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
+    ! global maps
+    INTEGER(i_std)                            :: nwbas
+    INTEGER(i_std), DIMENSION(nbpt)           :: basin_count
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)     :: basin_id, basin_flowdir
+    REAL(r_std), DIMENSION(nbpt,nwbas)        :: basin_area, basin_hierarchy, basin_topoind
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)     :: outflow_grid
+    INTEGER(i_std), DIMENSION(nbpt)           :: nbcoastal
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)     :: coastal_basin
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std)      :: ij, iz
+    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 smalest 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(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
+    !
+    ! This subroutine will make the connections between the basins and ensure global coherence.
+    !
+    ! The convention for outflow_grid is :
+    !  outflow_grid = -1 : River flow
+    !  outflow_grid = -2 : Coastal flow
+    !  outflow_grid = -3 : Return flow
+    !
+    !
+    ! INPUT
+    !
+    INTEGER(i_std), INTENT (in)                    :: nbpt
+    INTEGER(i_std), DIMENSION(nbpt,8), INTENT (in) :: neighbours
+    !
+    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
+    REAL(r_std), DIMENSION(nbpt,nwbas)             :: basin_area, basin_hierarchy
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: outflow_grid
+    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
+    REAL(r_std), INTENT(in)                        :: invented_basins
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: sp, sb, sbl, inp, bid, outdm1, outdp1
+    INTEGER(i_std) :: dp1, dm1, dm1i, dp1i, bp1, bm1
+    INTEGER(i_std) :: dop, bop
+    INTEGER(i_std) :: fbas(nwbas), nbfbas
+    REAL(r_std)    :: fbas_hierarchy(nwbas)
+    INTEGER(i_std) :: ff(1)
+    !
+    ! WARNING
+    LOGICAL, PARAMETER :: check = .FALSE.
+    ! ERRORS 
+    LOGICAL :: error1, error2, error3, error4, error5
+    
+    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,*) 'Coodinates : (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 conditons 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(nbpt, resolution, contfrac, nwbas, basin_count, basin_area, basin_id,&
+       & outflow_grid, outflow_basin, fetch_basin)
+    !
+    IMPLICIT NONE
+    !
+    ! This subroutine will compute 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
+    !
+    !
+    ! INPUT
+    !
+    INTEGER(i_std), INTENT(in)                             :: nbpt
+    !
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in)             :: resolution
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)               :: contfrac    ! Fraction of land in each grid box
+    !
+    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
+    INTEGER(i_std), DIMENSION(nbpt,nwbas), INTENT(in)      :: outflow_basin
+    REAL(r_std), DIMENSION(nbpt,nwbas), INTENT(out)        :: fetch_basin
+    !
+    ! LOCAL
+    !
+    INTEGER(i_std) :: ib, ij, ff(1), it, itt, igrif, ibasf, nboutflow
+    REAL(r_std)    :: contarea, 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 smalest 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(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
+    !
+    !
+    ! This subroutine reduces the number of basins per gird 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.
+    !
+    ! INPUT
+    !
+    INTEGER(i_std)                                   :: nbpt
+    !
+    REAL(r_std), DIMENSION(nbpt,2)                   :: resolution
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)         :: contfrac    ! Fraction of land in each grid box
+    !
+    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
+    REAL(r_std), DIMENSION(nbpt,nwbas)               :: basin_area
+    REAL(r_std), DIMENSION(nbpt,nwbas)               :: basin_topoind
+    REAL(r_std), DIMENSION(nbpt,nwbas)               :: fetch_basin
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)            :: outflow_grid
+    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
+    !
+    INTEGER(i_std), PARAMETER :: pickmax = 200
+    INTEGER(i_std) :: ib, ij, ibf, ijf, igrif, ibasf, cnt, pold, bold, ff(2)
+    INTEGER(i_std) :: ii, kbas, sbas, ik, iter, ibt, obj
+    REAL(r_std), DIMENSION(nbpt,nbasmax) :: floflo
+    REAL(r_std), DIMENSION(nbpt)   :: gridarea, gridbasinarea
+    REAL(r_std)                    :: ratio
+    INTEGER(i_std), DIMENSION(pickmax,2) :: largest_basins
+    INTEGER(i_std), DIMENSION(pickmax) :: tmp_ids
+    INTEGER(i_std) :: multbas, iml(1)
+    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
+    !
+    ! 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.
+    !
+    !
+    ! 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 smalest 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 runing into it
+          !   and puting the smalest 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 smalest 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 smalest 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 smalest
+                   !
+                   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 contienents
+    !
+    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
+       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)
+       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(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
+    !
+    ! The aim of this routine 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.
+    !
+    INTEGER(i_std)                                 :: tokill, totakeover
+    INTEGER(i_std)                                 :: nbpt, ib
+    !
+    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
+    REAL(r_std), DIMENSION(nbpt,nwbas)             :: basin_area
+    REAL(r_std), DIMENSION(nbpt,nwbas)             :: basin_topoind
+    REAL(r_std), DIMENSION(nbpt,nwbas)             :: fetch_basin
+    INTEGER(i_std), DIMENSION(nbpt,nwbas)          :: outflow_grid
+    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
+    !
+    INTEGER(i_std) :: inf, ibs, ing, inb, ibasf, igrif, it
+    LOGICAL       :: doshift
+    !
+    ! 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(numlar, basin_names)
+    !
+    IMPLICIT NONE
+    !
+    ! Arguments
+    !
+    INTEGER(i_std), INTENT(in)        :: numlar
+    CHARACTER(LEN=*), INTENT(inout)  :: basin_names(numlar)
+    !
+    ! Local
+    !
+    INTEGER(i_std), PARAMETER               :: listleng=349
+    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) = "Yangtze"
+    list_names(13) = "Chang Jiang"
+    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) = "Noname (GHAASBasin49)"
+    list_names(41) = "Kolyma"
+    list_names(42) = "Sao Francisco"
+    list_names(43) = "Amu-Darya"
+    list_names(44) = "Noname (GHAASBasin51)"
+    list_names(45) = "Dnepr"
+    list_names(46) = "Noname (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) = "Noname (GHAASBasin75)"
+    list_names(61) = "Parnaiba"
+    list_names(62) = "Noname (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) = "Noname (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) = "Noname (GHAASBasin95)"
+    list_names(84) = "Noname (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) = "Noname (GHAASBasin122)"
+    list_names(93) = "Noname (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) = "Noname (GHAASBasin47)"
+    list_names(100) = "Noname (GHAASBasin127)"
+    list_names(101) = "Hong"
+    list_names(102) = "Noname (GHAASBasin97)"
+    list_names(103) = "Swan-Avon"
+    list_names(104) = "Rhine"
+    list_names(105) = "Cuanza"
+    list_names(106) = "GHAASBasin106"
+    list_names(107) = "Noname (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) = "Noname (GHAASBasin165)"
+    list_names(115) = "Pyasina"
+    list_names(116) = "Fitzroy East"
+    list_names(117) = "Noname (GHAASBasin173)"
+    list_names(118) = "Albany"
+    list_names(119) = "Sanaga"
+    list_names(120) = "GHAASBasin120"
+    list_names(121) = "Noname (GHAASBasin178)"
+    list_names(122) = "Noname (GHAASBasin148)"
+    list_names(123) = "Brazos (Tex)"
+    list_names(124) = "GHAASBasin124"
+    list_names(125) = "Alabama"
+    list_names(126) = "Noname (GHAASBasin174)"
+    list_names(127) = "Noname (GHAASBasin179)"
+    list_names(128) = "Balsas"
+    list_names(129) = "Noname (GHAASBasin172)"
+    list_names(130) = "Burdekin"
+    list_names(131) = "Colorado (Texas)"
+    list_names(132) = "Noname (GHAASBasin150)"
+    list_names(133) = "Odra"
+    list_names(134) = "Loire"
+    list_names(135) = "Noname (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 (nbpt, index, lalo, neighbours, resolution, contfrac, &
+       &                       init_irrig, irrigated, init_flood, floodplains, hist_id, hist2_id)
+    !
+    ! This program will interpoalte the 0.5 x 05 deg based data set to the resolution 
+    ! of the model.
+    !
+    IMPLICIT NONE
+    !
+    ! INPUT
+    !
+    INTEGER(i_std), INTENT(in)    :: nbpt                ! Number of points for which the data needs to be interpolated
+    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 in m of each grid-box in X and Y
+    REAL(r_std), INTENT(in)       :: contfrac(nbpt)      ! Fraction of land in each grid box
+    LOGICAL, INTENT(in)          :: init_irrig          ! Do we need to compute irrigation ?
+    REAL(r_std), INTENT(out)      :: irrigated(:)        ! Irrigated surface in each grid-box
+    LOGICAL, INTENT(in)          :: init_flood          ! Do we need to compute floodplains
+    REAL(r_std), INTENT(out)      :: floodplains(:)      ! Surface which can be inondated in each grid-box
+    INTEGER(i_std), INTENT(in)    :: hist_id             ! Access to history file
+    INTEGER(i_std), INTENT(in)    :: hist2_id            ! Access to history file 2
+    !
+    ! LOCAL
+    !
+    CHARACTER(LEN=80) :: filename
+    INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, ilf, lastjp, nbexp
+    REAL(r_std) :: lev(1), date, dt, coslat, pi
+    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(:,:) :: irrigated_frac, flood_frac
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: loup_rel, lolow_rel, laup_rel, lalow_rel
+    REAL(r_std) :: area_irrig, area_flood, ax, ay, sgn, surp
+    REAL(r_std) :: lonrel, louprel, lolowrel
+    REAL(r_std)                              :: irrigmap(nbpt)
+    !
+    pi = 4. * ATAN(1.)
+    !
+    !Config Key  = IRRIGATION_FILE
+    !Config Desc = Name of file which contains the map of irrigated areas
+    !Config Def  = irrigated.nc
+    !Config If   = IRRIGATE
+    !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).
+    !
+    filename = 'irrigated.nc'
+    CALL getin_p('IRRIGATION_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 (irrigated_frac(iml,jml))
+    ALLOCATE (flood_frac(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(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, 'inundated', iml, jml, lml, tml, 1, 1, flood_frac)
+    CALL bcast(flood_frac)
+    !
+    IF (is_root_prc) CALL flinclo(fid)
+    !
+    ! Set to zero all fraction which are less than 0.5%
+    !
+    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
+          !
+          IF ( flood_frac(ip,jp) .LT. undef_sechiba-un) THEN
+             flood_frac(ip,jp) = flood_frac(ip,jp)/100
+             IF ( flood_frac(ip,jp) < 0.005 )  flood_frac(ip,jp) = zero
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    WRITE(numout,*) 'lon_rel : ', MAXVAL(lon_rel), MINVAL(lon_rel)
+    WRITE(numout,*) 'lat_rel : ', MAXVAL(lat_rel), MINVAL(lat_rel)
+    WRITE(numout,*) 'irrigated_frac : ', MINVAL(irrigated_frac, MASK=irrigated_frac .GT. 0), &
+         &                          MAXVAL(irrigated_frac, MASK=irrigated_frac .LT. undef_sechiba)
+    WRITE(numout,*) 'flood_frac : ', MINVAL(flood_frac, MASK=flood_frac .GT. 0), &
+         &                      MAXVAL(flood_frac, MASK=flood_frac .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. ), 0.001 )*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
+       area_irrig = zero
+       area_flood = 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. ), 0.001 )
+                   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
+                   !
+                   IF (irrigated_frac(ip,jp) .LT. undef_sechiba-1.) THEN
+                      area_irrig = area_irrig + ax*ay*irrigated_frac(ip,jp)
+                   ENDIF
+                   !
+                   IF (flood_frac(ip,jp) .LT. undef_sechiba-un) THEN
+                      area_flood = area_flood + ax*ay*flood_frac(ip,jp)
+                   ENDIF                      
+                   !
+                ENDIF
+                !
+             ENDDO
+             !
+          ENDIF
+          !
+       ENDDO
+       !
+       ! Put the toal 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, 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
+       ENDIF
+       !
+       !
+    ENDDO
+    !
+    IF ( init_irrig .AND. init_flood ) THEN
+       DO ib = 1, nbpt
+          IF ( floodplains(ib)+irrigated(ib) > resolution(ib,1)*resolution(ib,2)*contfrac(ib) ) THEN
+             surp = (resolution(ib,1)*resolution(ib,2)*contfrac(ib))/(floodplains(ib)+irrigated(ib))
+             floodplains(ib) = floodplains(ib) * surp
+             irrigated(ib) = irrigated(ib) * surp
+          ENDIF
+       ENDDO
+    ENDIF
+    !
+    IF ( init_irrig ) THEN
+       WRITE(numout,*) 'RESULT irrigated : ', MINVAL(irrigated), MAXVAL(irrigated) 
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite(hist_id, 'irrigmap', 1, irrigmap, 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, irrigmap, nbpt, index)
+          ELSE
+             CALL histwrite(hist2_id, 'IrrigationMap', 1, irrigated, nbpt, index)
+          ENDIF
+       ENDIF
+    ENDIF
+    !
+    IF ( init_flood ) THEN
+       WRITE(numout,*) 'RESULT floodplains : ', MINVAL(floodplains), MAXVAL(floodplains) 
+    ENDIF
+    !
+  END SUBROUTINE routing_irrigmap
+  !
+  !---------------------------------------------------------------------------------
+  !
+  SUBROUTINE routing_waterbal(nbpt, firstcall, runoff, drainage, returnflow, &
+               & irrigation, riverflow, coastalflow)
+    !
+    IMPLICIT NONE
+    !
+    ! This subroutine should allow us to check the water balance in the routing module.
+    !
+    INTEGER(i_std), INTENT(in)    :: nbpt                ! Domain size
+    LOGICAL, INTENT(in)          :: firstcall           ! controls behaviour
+    REAL(r_std), INTENT(in)       :: runoff(nbpt)        ! grid-point runoff
+    REAL(r_std), INTENT(in)       :: drainage(nbpt)      ! grid-point drainage
+    REAL(r_std), INTENT(in)       :: returnflow(nbpt)    ! The water flow which returns to the grid box (kg/m^2/dt)
+    REAL(r_std), INTENT(in)       :: irrigation(nbpt)    ! Irrigation flux (kg/m^2 per dt)
+    REAL(r_std), INTENT(in)       :: riverflow(nbpt)     ! Outflow of the major rivers (kg/dt)
+    REAL(r_std), INTENT(in)       :: coastalflow(nbpt)   ! Outflow on coastal points by small basins (kg/dt)
+    !
+    ! We sum-up all the water we have in the warious reservoirs
+    !
+    REAL(r_std), SAVE :: totw_stream, totw_fast, totw_slow, totw_lake
+    REAL(r_std), SAVE :: totw_in, totw_out, totw_return, totw_irrig, totw_river, totw_coastal
+    REAL(r_std)       :: totarea, area
+    !
+    ! Just to make sure we do not get too large numbers !
+    !
+    REAL(r_std), PARAMETER :: scaling = 1.0E+6
+    REAL(r_std), PARAMETER :: allowed_err = 50.
+    !
+    INTEGER(i_std)    :: ig
+    !
+    IF ( firstcall ) THEN
+       !
+       totw_stream = zero
+       totw_fast = zero
+       totw_slow = zero
+       totw_lake = zero
+       totw_in = zero
+       !
+       DO ig=1,nbpt
+          !
+          totarea = SUM(routing_area(ig,:))
+          !
+          totw_stream = totw_stream + SUM(stream_reservoir(ig,:)/scaling)
+          totw_fast = totw_fast + SUM(fast_reservoir(ig,:)/scaling)
+          totw_slow = totw_slow + SUM(slow_reservoir(ig,:)/scaling)
+          totw_lake = totw_lake + lake_reservoir(ig)/scaling
+          !
+          totw_in = totw_in + (runoff(ig)*totarea + drainage(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_stream = totw_stream - SUM(stream_reservoir(ig,:)/scaling)
+          totw_fast = totw_fast - SUM(fast_reservoir(ig,:)/scaling)
+          totw_slow = totw_slow - SUM(slow_reservoir(ig,:)/scaling)
+          totw_lake = totw_lake - lake_reservoir(ig)/scaling
+          !
+          totw_return = totw_return + returnflow(ig)*totarea/scaling
+          totw_irrig = totw_irrig + irrigation(ig)*totarea/scaling
+          totw_river = totw_river + riverflow(ig)/scaling
+          totw_coastal = totw_coastal + coastalflow(ig)/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_stream + totw_fast + totw_slow + totw_lake) - (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 : stream fast ', totw_stream, totw_fast
+          WRITE(numout,*) '--Water-- change : slow, lake ', totw_slow, totw_lake
+          WRITE(numout,*) '--Water>>> change in the routing res. : ', 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_stream + totw_fast + totw_slow + totw_lake) - (totw_out - totw_in))/area
+       ENDIF
+       !
+    ENDIF
+    !
+  END SUBROUTINE routing_waterbal
+  !
+  !
+END MODULE routing
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/sechiba.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/sechiba.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/sechiba.f90	(revision 854)
@@ -0,0 +1,1642 @@
+!  ==============================================================================================================================\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_veg
+  USE constantes_co2
+  USE diffuco
+  USE condveg
+  USE enerbil
+  USE hydrol                                                                     !! 
+  USE hydrolc
+  USE thermosoil
+  USE sechiba_io
+  USE slowproc
+  USE routing
+!  USE write_field_p, only : WriteFieldI_p
+
+
+  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
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexnobio     !! indexing array for the 3D fields of other surfaces (ice,
+                                                                     !! lakes, ...)
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexsoil      !! indexing array for the 3D fields of soil types
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexgrnd      !! indexing array for the 3D ground heat profiles
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexlayer     !! indexing array for the 3D fields of soil layers 
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:) :: indexalb       !! indexing array for the 2 fields of albedo
+ 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: veget          !! Fraction of vegetation type (unitless, 0-1)       
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: veget_max      !! Max. fraction of vegetation type (LAI -> infty, unitless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: height         !! Vegetation Height (m)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: lai            !! Leaf area index @tex $(m^2 m^{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: gpp            !! Gross Primary Production 
+                                                                     !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: humrel         !! Soil moisture stress factor on transpiration 
+                                                                     !! (unitless, 0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vegstress      !! Vegetation moisture stress (only for growth) 
+                                                                     !! (unitless, 0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: soiltype       !! Map of soil types (order: silt, sand and clay), 
+                                                                     !! created in slowproc (unitless, 0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: co2_flux       !! CO2 flux of ??WHAT?? (gC m^{-2} dtradia^{-1})??
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:):: assim_param    !! min+max+opt temps, vcmax, vjmax for photosynthesis 
+                                                                     !! @tex $(K, \mumol m^{-2} s^{-1})$ @endtex
+  
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta1         !! Snow resistance (unitless,0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta4         !! Bare soil resistance (unitless,0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: soilcap        !! Soil heat capacity @tex $(J K^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: soilflx        !! Soil heat flux @tex $(W m^{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: temp_sol       !! Soil temperature (K)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: qsurf          !! Near soil air moisture @tex $(kg kg^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: snow           !! Snow mass @tex $(kg m^2)$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: snow_age       !! Snow age (days)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: drysoil_frac   !! Fraction of visible dry soil for albedo (unitless, 0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: rsol           !! Resistance to bare soil evaporation 
+                                                                     !! @tex $(s m^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evap_bare_lim  !! Bare soil stress (unitless, 0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evapot         !! Soil Potential Evaporation 
+                                                                     !! @tex $(kg m^{-2} days^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: evapot_corr    !! Soil Potential Evaporation Correction (Milly 1992) 
+                                                                     !! @tex $(kg m^{-2} days^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapsno       !! Snow evaporation 
+                                                                     !! @tex $(kg m^{-2} days^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vevapnu        !! Bare soil evaporation 
+                                                                     !! @tex $(kg m^{-2} days^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: t2mdiag        !! 2 meter temperature (K)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: tot_melt       !! Total melt @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: vbeta          !! Resistance coefficient (unitless,0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: valpha         !! Resistance coefficient (unitless,0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: fusion         !! ??
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: rau            !! Air density @tex $(kg m^{-3})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: deadleaf_cover !! Fraction of soil covered by dead leaves (unitless, 0-1) 
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: totfrac_nobio  !! Total fraction of continental ice+lakes+cities+...
+                                                                     !! (unitless, 0-1)
+  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 (:)    :: drainage       !! Deep drainage calculatedd by hydrol or hydrolc 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: returnflow     !! Water flow from lakes and swamps which returns to 
+                                                                     !! the grid box @tex $(kg m^{-2})$ @endtex
+  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
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: emis           !! Surface emissivity (unitless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: z0             !! Surface roughness (m)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: roughheight    !! Effective height for roughness (m)
+   
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: shumdiag       !! Mean relative soil moisture in the different levels used 
+                                                                     !! by thermosoil.f90 (unitless, 0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)    :: litterhumdiag  !! Litter dryness factor (unitless, 0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: stempdiag      !! Temperature which controls canopy evolution (K)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: qsintveg       !! Water on vegetation due to interception 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta2         !! Interception resistance (unitless,0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbeta3         !! Vegetation resistance (unitless,0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vbetaco2       !! STOMATE: Vegetation resistance to CO2 (unitless,0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: cimean         !! STOMATE: mean intercellular CO2 concentration 
+                                                                     !! @tex $(\mumol m^{-2} s^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: vevapwet       !! Interception loss over each PFT 
+                                                                     !! @tex $(kg m^{-2} days^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: transpir       !! Transpiration @tex $(kg m^{-2} days^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: qsintmax       !! Maximum amount of water in the canopy interception 
+                                                                     !! reservoir @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: rveget         !! Surface resistance for the vegetation 
+                                                                     !! @tex $(s m^{-1})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: snow_nobio     !! Snow mass of non-vegetative surfaces 
+                                                                     !! @tex $(kg m^{-2})$ @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: snow_nobio_age !! Snow age on non-vegetative surfaces (days)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: frac_nobio     !! Fraction of non-vegetative surfaces (continental ice, 
+                                                                     !! lakes, ...) (unitless, 0-1)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)  :: albedo         !! Surface albedo for visible and near-infrared 
+                                                                     !! (unitless, 0-1)
+  
+  LOGICAL, SAVE                                    :: l_first_sechiba = .TRUE. !! Flag controlling the intialisation (true/false)
+  CHARACTER(LEN=80) , SAVE                         :: var_name                 !! To store variables names for I/O (unitless)
+  LOGICAL, SAVE                                    :: river_routing            !! Flag that decides if we route surface runoff 
+                                                                               !! and deep drainage to the ocean through the 
+                                                                               !! rivers
+  LOGICAL, SAVE                                    :: hydrol_cwrr              !! Flag that decides if we use the 11-layer 
+                                                                               !! hydrology module. If not, Choisnel module is 
+                                                                               !! taken.
+  LOGICAL, SAVE                                    :: myfalse=.FALSE.          !! Local flag (true/false)
+  LOGICAL, SAVE                                    :: mytrue=.TRUE.            !! Local flag (true/false)
+
+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, 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)
+
+!! 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)            :: 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), 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})??
+
+!! 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)
+
+!! 0.4 local variables
+
+    INTEGER(i_std)                                           :: 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)
+!_ ================================================================================================================================
+
+    IF (long_print) WRITE(numout,*) ' 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('UNITS', '-')
+          CALL ioconf_setatt('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('UNITS', '-')
+          CALL ioconf_setatt('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('UNITS', '-')
+          CALL ioconf_setatt('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
+       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, soiltype, &
+            t2mdiag, t2mdiag, temp_sol, stempdiag, vegstress, shumdiag, litterhumdiag, &
+            precip_rain, precip_snow, gpp, deadleaf_cover, assim_param, &
+            lai, height, veget, frac_nobio, 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)
+       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, u, v, &
+            & zlev, z0, roughheight, temp_sol, temp_air, rau, tq_cdrag, qsurf, qair, q2m, t2m, pb ,  &
+            & rsol, evap_bare_lim, evapot, snow, frac_nobio, snow_nobio, totfrac_nobio, &
+            & swnet, swdown, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, &
+            & vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, rveget, cimean, 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, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef,&
+            & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, &
+            & cimean, ccanopy, emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, &
+            & vevapp, transpir, gpp, vevapnu, vevapwet, vevapsno, 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
+          
+          var_name='runoff' ;
+          CALL ioconf_setatt('UNITS', 'mm/d')
+          CALL ioconf_setatt('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('UNITS', 'mm/d')
+          CALL ioconf_setatt('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
+
+          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, &
+               & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+               & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,&
+               & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, humrel, &
+               & vegstress, rsol, drysoil_frac, evapot, evapot_corr, shumdiag, litterhumdiag, soilcap, rest_id, hist_id, hist2_id) 
+          evap_bare_lim(:) = -un
+       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, &
+               & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+               & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,&
+               & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, humrel, &
+               & vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, &
+               & shumdiag, litterhumdiag, soilcap, soiltype, rest_id, hist_id, hist2_id)
+       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, deadleaf_cover, emis, albedo, z0, roughheight, soiltype, 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, 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, ldrestart_read, ldrestart_write, index, &
+               & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, runoff, &
+               & drainage, evapot_corr, precip_rain, humrel, &
+               & stempdiag, returnflow, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id)
+       ELSE
+          !! 1.12.2 No routing, set variables to zero
+          riverflow(:) = zero
+          coastalflow(:) = zero
+          returnflow(:) = zero
+          irrigation(:) = 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, 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, snow, frac_nobio, snow_nobio, totfrac_nobio, &
+         & swnet, swdown, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, &
+         & vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, rveget, cimean, rest_id, hist_id, hist2_id)
+
+    
+    !! 2.3 Compute energy balance
+    CALL enerbil_main (kjit, kjpindex, dtradia, ldrestart_read, myfalse, &
+         & index, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef, &
+         & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, &
+         & cimean, ccanopy, emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, &
+         & vevapp, transpir, gpp, vevapnu, vevapwet, vevapsno, 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, &
+            & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+            & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,&
+            & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, humrel, &
+            & vegstress, rsol, drysoil_frac, evapot, evapot_corr, shumdiag, litterhumdiag, soilcap, rest_id, hist_id, hist2_id) 
+       evap_bare_lim(:) = -un
+    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, &
+            & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+            & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,&
+            & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, humrel, &
+            & vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, &
+            & shumdiag, litterhumdiag, soilcap, soiltype, rest_id, hist_id, hist2_id)
+    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, deadleaf_cover, emis, albedo, z0, roughheight, soiltype, 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, 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, ldrestart_read, myfalse, index, &
+            & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, runoff, &
+            & drainage, evapot_corr, precip_rain, humrel, &
+            & stempdiag, returnflow, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id)
+       !       returnflow(:) = returnflow(:) * 100.
+    ELSE
+       !! 2.8.2 No routing, set variables to zero
+       riverflow(:) = zero
+       coastalflow(:) = zero
+       returnflow(:) = zero
+       irrigation(:) = zero
+    ENDIF
+
+    !! 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, soiltype, &
+         t2mdiag, t2mdiag, temp_sol, stempdiag, &
+         vegstress, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+         deadleaf_cover, &
+         assim_param, &
+         lai, height, veget, frac_nobio, 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)
+   
+    !! 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
+    IF ( .NOT. almaoutput ) THEN
+       ! Write history file in IPSL-format
+       CALL histwrite(hist_id, 'beta', kjit, vbeta, kjpindex, index)
+       CALL histwrite(hist_id, 'z0', kjit, z0, kjpindex, index)
+       CALL histwrite(hist_id, 'roughheight', kjit, roughheight, kjpindex, index)
+       CALL histwrite(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite(hist_id, 'lai', kjit, lai, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'subli', kjit, vevapsno, kjpindex, index)
+       CALL histwrite(hist_id, 'evapnu', kjit, vevapnu, kjpindex, index)
+       CALL histwrite(hist_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'vbeta1', kjit, vbeta1, kjpindex, index)
+       CALL histwrite(hist_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'vbeta4', kjit, vbeta4, kjpindex, index)    
+       CALL histwrite(hist_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index)
+       CALL histwrite(hist_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'rsol', kjit, rsol, kjpindex, index)
+       CALL histwrite(hist_id, 'snow', kjit, snow, kjpindex, index)
+       CALL histwrite(hist_id, 'snowage', kjit, snow_age, kjpindex, index)
+       CALL histwrite(hist_id, 'snownobio', kjit, snow_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite(hist_id, 'snownobioage', kjit, snow_nobio_age, kjpindex*nnobio, indexnobio)
+       CALL histwrite(hist_id, 'soiltype',  kjit, soiltype, kjpindex*nstm, indexsoil)
+       IF ( control%ok_co2 ) THEN
+          CALL histwrite(hist_id, 'vbetaco2', kjit, vbetaco2, kjpindex*nvm, indexveg)    
+          CALL histwrite(hist_id, 'gpp', kjit, gpp, kjpindex*nvm, indexveg)
+          CALL histwrite(hist_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg)    
+       ENDIF
+       IF ( control%ok_stomate ) THEN
+          CALL histwrite(hist_id, 'nee', kjit, co2_flux, kjpindex*nvm, indexveg)    
+       ENDIF
+
+       histvar(:)=SUM(vevapwet(:,:),dim=2)/one_day
+       CALL histwrite(hist_id, 'evspsblveg', kjit, histvar, kjpindex, index)
+
+       histvar(:)=(vevapnu(:)+vevapsno(:))/one_day
+       CALL histwrite(hist_id, 'evspsblsoi', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(transpir(:,:),dim=2)/one_day
+       CALL histwrite(hist_id, 'tran', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(veget_max(:,2:9),dim=2)*100*contfrac(:)
+       CALL histwrite(hist_id, 'treeFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(veget_max(:,10:11),dim=2)*100*contfrac(:)
+       CALL histwrite(hist_id, 'grassFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(veget_max(:,12:13),dim=2)*100*contfrac(:)
+       CALL histwrite(hist_id, 'cropFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=veget_max(:,1)*100*contfrac(:)
+       CALL histwrite(hist_id, 'baresoilFrac', kjit, histvar, kjpindex, index)
+
+       histvar(:)=SUM(frac_nobio(:,1:nnobio),dim=2)*100*contfrac(:)
+       CALL histwrite(hist_id, 'residualFrac', kjit, histvar, kjpindex, index)
+    ELSE
+       ! Write history file in ALMA format 
+       CALL histwrite(hist_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+       CALL histwrite(hist_id, 'Qf', kjit, fusion, kjpindex, index)
+       CALL histwrite(hist_id, 'SWE', kjit, snow, kjpindex, index)
+       CALL histwrite(hist_id, 'ESoil', kjit, vevapnu, kjpindex, index)
+       CALL histwrite(hist_id, 'TVeg', kjit, transpir, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'ECanop', kjit, vevapwet, kjpindex*nvm, indexveg)
+       CALL histwrite(hist_id, 'ACond', kjit, tq_cdrag, kjpindex, index)
+       CALL histwrite(hist_id, 'SnowFrac', kjit, vbeta1, kjpindex, index)
+       IF ( control%ok_co2 ) THEN
+          CALL histwrite(hist_id, 'GPP', kjit, gpp, kjpindex*nvm, indexveg)
+       ENDIF
+       IF ( control%ok_stomate ) THEN
+             CALL histwrite(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(hist2_id, 'tsol_rad', kjit, tsol_rad, kjpindex, index)
+          CALL histwrite(hist2_id, 'qsurf', kjit, qsurf, kjpindex, index)
+          CALL histwrite(hist2_id, 'albedo', kjit, albedo, kjpindex*2, indexalb)
+          CALL histwrite(hist2_id, 'emis', kjit, emis, kjpindex, index)
+          CALL histwrite(hist2_id, 'beta', kjit, vbeta, kjpindex, index)
+          CALL histwrite(hist2_id, 'z0', kjit, z0, kjpindex, index)
+          CALL histwrite(hist2_id, 'roughheight', kjit, roughheight, kjpindex, index)
+          CALL histwrite(hist2_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite(hist2_id, 'lai', kjit, lai, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'subli', kjit, vevapsno, kjpindex, index)
+          CALL histwrite(hist2_id, 'vevapnu', kjit, vevapnu, kjpindex, index)
+          CALL histwrite(hist2_id, 'transpir', kjit, transpir, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'inter', kjit, vevapwet, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'vbeta1', kjit, vbeta1, kjpindex, index)
+          CALL histwrite(hist2_id, 'vbeta2', kjit, vbeta2, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'vbeta3', kjit, vbeta3, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'vbeta4', kjit, vbeta4, kjpindex, index)    
+          CALL histwrite(hist2_id, 'drysoil_frac', kjit, drysoil_frac, kjpindex, index)
+          CALL histwrite(hist2_id, 'rveget', kjit, rveget, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'rsol', kjit, rsol, kjpindex, index)
+          CALL histwrite(hist2_id, 'snow', kjit, snow, kjpindex, index)
+          CALL histwrite(hist2_id, 'snowage', kjit, snow_age, kjpindex, index)
+          CALL histwrite(hist2_id, 'snownobio', kjit, snow_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite(hist2_id, 'snownobioage', kjit, snow_nobio_age, kjpindex*nnobio, indexnobio)
+          CALL histwrite(hist2_id, 'soiltype',  kjit, soiltype, kjpindex*nstm, indexsoil)
+          IF ( control%ok_co2 ) THEN
+             CALL histwrite(hist2_id, 'vbetaco2', kjit, vbetaco2, kjpindex*nvm, indexveg)    
+             CALL histwrite(hist2_id, 'gpp', kjit, gpp, kjpindex*nvm, indexveg)
+             CALL histwrite(hist2_id, 'cimean', kjit, cimean, kjpindex*nvm, indexveg)    
+          ENDIF
+          IF ( control%ok_stomate ) THEN
+             CALL histwrite(hist2_id, 'nee', kjit, co2_flux, kjpindex*nvm, indexveg)    
+          ENDIF
+       ELSE
+          ! Write history file in ALMA format
+          CALL histwrite(hist2_id, 'vegetfrac', kjit, veget, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'maxvegetfrac', kjit, veget_max, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'nobiofrac', kjit, frac_nobio, kjpindex*nnobio, indexnobio)
+          CALL histwrite(hist2_id, 'Qf', kjit, fusion, kjpindex, index)
+          CALL histwrite(hist2_id, 'SWE', kjit, snow, kjpindex, index)
+          CALL histwrite(hist2_id, 'ESoil', kjit, vevapnu, kjpindex, index)
+          CALL histwrite(hist2_id, 'TVeg', kjit, transpir, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'ECanop', kjit, vevapwet, kjpindex*nvm, indexveg)
+          CALL histwrite(hist2_id, 'ACond', kjit, tq_cdrag, kjpindex, index)
+          CALL histwrite(hist2_id, 'SnowFrac', kjit, vbeta1, kjpindex, index)
+          IF ( control%ok_co2 ) THEN
+             CALL histwrite(hist2_id, 'GPP', kjit, gpp, kjpindex*nvm, indexveg)
+          ENDIF
+          IF ( control%ok_stomate ) THEN
+             CALL histwrite(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, 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, snow, frac_nobio, snow_nobio, totfrac_nobio, &
+            & swnet, swdown, ccanopy, humrel, veget, veget_max, lai, qsintveg, qsintmax, assim_param, &
+            & vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, rveget, cimean, 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, zlev, lwdown, swnet, epot_air, temp_air, u, v, petAcoef, petBcoef,&
+            & qair, peqAcoef, peqBcoef, pb, rau, vbeta, valpha, vbeta1, vbeta2, vbeta3, vbeta4, vbetaco2, &
+            & cimean, ccanopy, emis, soilflx, soilcap, tq_cdrag, humrel, fluxsens, fluxlat, &
+            & vevapp, transpir, gpp, vevapnu, vevapwet, vevapsno, 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, &
+               & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+               & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,&
+               & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, &
+               & humrel, vegstress, rsol, drysoil_frac, evapot, evapot_corr, shumdiag, litterhumdiag, soilcap, &
+               & rest_id, hist_id, hist2_id)
+          evap_bare_lim(:) = -un
+       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, &
+               & temp_sol_new, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max,&
+               & qsintmax, qsintveg, vevapnu, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age,&
+               & tot_melt, transpir, precip_rain, precip_snow, returnflow, irrigation, humrel, &
+               & vegstress, drysoil_frac, evapot, evapot_corr, evap_bare_lim, &
+               & shumdiag, litterhumdiag, soilcap, soiltype, rest_id, hist_id, hist2_id)
+          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, deadleaf_cover, emis, albedo, z0, roughheight, soiltype, 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, 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, ldrestart_read, ldrestart_write, index, &
+               & lalo, neighbours, resolution, contfrac, totfrac_nobio, veget_max, runoff, &
+               & drainage, evapot_corr, precip_rain, humrel, &
+               & stempdiag, returnflow, irrigation, riverflow, coastalflow, rest_id, hist_id, hist2_id)
+       ELSE
+          !! 3.6.2 No routing, set variables to zero
+          riverflow(:) = zero
+          coastalflow(:) = zero
+          returnflow(:) = zero
+          irrigation(:) = zero
+       ENDIF ! river_routing
+
+       !! 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, soiltype, &
+            t2mdiag, t2mdiag, temp_sol, stempdiag, &
+            vegstress, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+            deadleaf_cover, &
+            assim_param, &
+            lai, height, veget, frac_nobio, 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)
+       ! 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 (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 (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 (soiltype(kjpindex,nstm),stat=ier)
+    IF (ier.NE.0) THEN
+       WRITE (numout,*) ' error in soiltype allocation. We stop. we need kjpindex words = ',kjpindex
+       STOP 'sechiba_init'
+    END IF
+    soiltype(:,:)=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 (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 (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 (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 (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 (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 (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),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 (irrigation(kjpindex),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 (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
+
+    !! 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
+
+    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 (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
+
+    !! 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, nvm
+          indexveg((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       ENDDO
+       !      
+       DO jv = 1, nstm
+          indexsoil((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       ENDDO
+       !      
+       DO jv = 1, nnobio
+          indexnobio((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       ENDDO
+       !
+       DO jv = 1, ngrnd
+          indexgrnd((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       ENDDO
+       !
+       DO jv = 1, nslm
+          indexlayer((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       ENDDO
+       !
+       DO jv = 1, 2
+          indexalb((jv-1)*kjpindex + ji) = INDEX(ji) + (jv-1)*kjpij
+       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%ok_pheno = control_in%ok_pheno
+    control%stomate_watchout = control_in%stomate_watchout
+
+    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 (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 (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 (soiltype)) DEALLOCATE (soiltype)
+    IF ( ALLOCATED (vbeta1)) DEALLOCATE (vbeta1)
+    IF ( ALLOCATED (vbeta4)) DEALLOCATE (vbeta4)
+    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 (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 (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 (vevapsno)) DEALLOCATE (vevapsno)
+    IF ( ALLOCATED (vevapnu)) DEALLOCATE (vevapnu)
+    IF ( ALLOCATED (t2mdiag)) DEALLOCATE (t2mdiag)
+    IF ( ALLOCATED (totfrac_nobio)) DEALLOCATE (totfrac_nobio)
+    IF ( ALLOCATED (runoff)) DEALLOCATE (runoff)
+    IF ( ALLOCATED (drainage)) DEALLOCATE (drainage)
+    IF ( ALLOCATED (returnflow)) DEALLOCATE (returnflow)
+    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 (vevapwet)) DEALLOCATE (vevapwet)
+    IF ( ALLOCATED (transpir)) DEALLOCATE (transpir)
+    IF ( ALLOCATED (qsintmax)) DEALLOCATE (qsintmax)
+    IF ( ALLOCATED (rveget)) DEALLOCATE (rveget)
+
+!! 3. Clear all allocated memory
+    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: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/sechiba_io.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/sechiba_io.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/sechiba_io.f90	(revision 854)
@@ -0,0 +1,468 @@
+!! 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 constantes_veg
+  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
+
+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: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/sechiba_io_p.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/sechiba_io_p.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/sechiba_io_p.f90	(revision 854)
@@ -0,0 +1,523 @@
+!! 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 constantes_veg
+  USE ioipsl
+  USE parallel
+  
+  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
+
+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) &
+              ALLOCATE( val_tmp_g(nbp_glo) )
+           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 )
+           IF (is_root_prc) &
+              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 an 2D array real with an other 2D array real. 
+SUBROUTINE r22setvar_p (var, val_exp, key_wd, val_put, is_grid)
+  
+  ! 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
+  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,*) "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
+       CALL getin_p(key_wd,  val_tmp)
+     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: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/slowproc.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/slowproc.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/slowproc.f90	(revision 854)
@@ -0,0 +1,4821 @@
+! =================================================================================================================================
+! 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_veg
+  USE constantes_co2
+  USE ioipsl
+  USE sechiba_io
+  USE interpol_help
+  USE stomate
+  USE stomate_constants
+  USE grid
+  USE parallel
+  !  USE Write_Field_p
+
+  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
+  REAL(r_std), SAVE                               :: dt_slow                    !! time step of slow processes and STOMATE
+  !
+  REAL(r_std), SAVE                               :: clayfraction_default = 0.2 !! Default value for clay fraction (0-1, unitless)   
+
+  INTEGER(i_std) , SAVE                           :: veget_update=0             !! update frequency in years for landuse (nb of years)
+  INTEGER(i_std) , SAVE                           :: veget_year_orig=0          !! first year for landuse (number)
+  LOGICAL, SAVE                                   :: land_use = .FALSE.         !! flag to account or not for Land Use
+  LOGICAL, SAVE                                   :: veget_reinit=.FALSE.       !! To change LAND USE file in a run.
+  !
+  LOGICAL, SAVE                                   :: read_lai = .FALSE.         !! Flag to read a map of LAI if STOMATE is not activated
+  LOGICAL, SAVE                                   :: old_lai = .FALSE.          !! Flag for the old LAI map interpolation (SHOULD BE DROPED ??)
+  LOGICAL, SAVE                                   :: impveg = .FALSE.           !! Flag to impose the vegetation ??
+  LOGICAL, SAVE                                   :: impsoilt = .FALSE.         !! Flag to impose the soil texture ?? 
+  LOGICAL, SAVE                                   :: old_veget = .FALSE.        !! Flag to use the old vegetation Map interpolation (SHOULD BE DROPED ?)
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: clayfraction            !! Clayfraction (0-1, unitless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:)  :: laimap                  !! LAI map when the LAI is prescribed and not calculated by STOMATE
+  !
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: veget_nextyear          !! next year fraction of vegetation type (0-1, unitless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:)    :: frac_nobio_nextyear     !! next year fraction of ice+lakes+cities+... (0-1, unitless)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)      :: totfrac_nobio_nextyear  !! next year total fraction of ice+lakes+cities+... (0-1, unitless)
+
+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, soiltype, &
+       t2m, t2m_min, temp_sol, stempdiag, &
+       humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, gpp, &
+       deadleaf_cover, &
+       assim_param, &
+       lai, height, veget, frac_nobio, 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)
+  
+!! 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
+    ! input fields
+    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), 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   
+    
+!! 0.2 Output variables 
+    REAL(r_std), DIMENSION (kjpindex,nvm), 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})
+    
+!! 0.3 Modified variables
+    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), 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)    :: soiltype       !! fraction of soil type
+    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
+    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,nvm)               :: 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
+    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  
+
+! ==============================================================================\n
+
+! 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, veget, frac_nobio, totfrac_nobio, soiltype, veget_max, 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
+       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, height, veget, veget_max, qsintmax, &
+               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)
+
+       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)
+       ENDIF
+
+       RETURN
+
+    ENDIF
+    
+! DELETE
+!$    ! Land USE for next year
+!$    land_use_updated=.FALSE.
+!$    IF ( (land_use) .AND. (veget_update .GT. 0) ) THEN
+!$       ! if next iteration is divisibled by veget_update
+!$       IF ( mod(kjit+1, veget_update) .le. min_sechiba) THEN
+!$          !
+!$          veget_year=veget_year+veget_year_add
+!$          WRITE(numout,*)  'We are updating veget for year =' , veget_year
+!$          !
+!$          ! Save veget
+!$          !
+!$          veget_lastyear(:,:) = veget_max(:,:)
+!$          !
+!$          CALL slowproc_update(kjpindex, lalo, neighbours, resolution, contfrac, &
+!$               &               veget_max, frac_nobio, veget_year)                
+!$
+!$          land_use_updated=.TRUE.
+!$       ENDIF
+!$    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)
+       !
+       var_name= 'soiltype_frac'
+       CALL restput_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, soiltype, 'scatter',  nbp_glo, index_g)
+       !
+       var_name= 'clay_frac'
+       CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, clayfraction, '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, height, veget, veget_max, qsintmax, &
+               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)
+       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(*,*) "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(*,*) "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)
+             
+             ! If some PFTs has disapeared in new map
+             WHERE(veget_nextyear(:,:).LT.veget(:,:))
+                veget(:,:) = veget_nextyear(:,:)
+             ENDWHERE
+             !
+             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, height, veget, veget_max, qsintmax, &
+            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)
+
+       ! 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(hist_id, 'maint_resp', kjit, resp_maint, kjpindex*nvm, indexveg)
+          CALL histwrite(hist_id, 'hetero_resp', kjit, resp_hetero, kjpindex*nvm, indexveg)
+          CALL histwrite(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(hist_id, 'npp', kjit, npp, kjpindex*nvm, indexveg)
+       ENDIF
+
+       IF ( hist2_id > 0 ) THEN
+          IF ( control%ok_stomate ) THEN
+             CALL histwrite(hist2_id, 'maint_resp', kjit, resp_maint, kjpindex*nvm, indexveg)
+             CALL histwrite(hist2_id, 'hetero_resp', kjit, resp_hetero, kjpindex*nvm, indexveg)
+             CALL histwrite(hist2_id, 'growth_resp', kjit, resp_growth, kjpindex*nvm, indexveg)
+             CALL histwrite(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
+
+       ! 6.1 test if we have work to do
+       !
+       IF ( do_slow .OR. land_use_updated ) THEN
+
+          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)
+
+          ! 6.1.2 Case of land cover updated: reset the new maximum
+          ! vegetation covers to the new ones and the bare soil fraction
+          IF (land_use_updated) THEN
+             veget_max(:,:)=veget_nextyear(:,:)
+             frac_nobio(:,:)=frac_nobio_nextyear(:,:)
+          ENDIF
+          !
+          ! 6.1.3 updates the vegetation fraction with slowproc_veget
+          ! Recompute the total fraction of non biospheric areas (lake, cities,..)
+          CALL slowproc_veget (kjpindex, lai, frac_nobio, veget_max, veget)
+          totfrac_nobio(:) = zero
+          DO jv = 1, nnobio
+             totfrac_nobio(:) = totfrac_nobio(:) + frac_nobio(:,jv)
+          ENDDO
+
+          ! 6.1.4 updates the maximum interception capacity of the vegetation
+          ! (qsintmax) and other variables derived from the vegetation cover
+          CALL slowproc_derivvar (kjpindex, veget, lai, &
+               qsintmax, deadleaf_cover, assim_param, height)
+
+          ! 6.2 Specific case of neither do_slow nor land_use_updated
+          !    STRANGE should not match with the condition below
+       ELSE
+          ! Can not be true ????? 
+          IF (land_use_updated) THEN
+             frac_nobio(:,:)=frac_nobio_nextyear(:,:)
+          ENDIF
+          !
+       ENDIF
+
+       ! 6.3 Define the CO2 flux from the grid point to zero (no carbone cycle)
+       co2_flux(:,:) = zero
+
+    ENDIF
+
+    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, veget, frac_nobio, totfrac_nobio, soiltype, veget_max, 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)
+
+  !! 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,nstm), INTENT(out)   :: soiltype       !! fraction of soil type in the pixel (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, INTENT(out)                                  :: read_lai       !! Flag related to the read of laimap 
+  REAL(r_std)                                           :: frac_nobio1    !! temporary variable for frac_nobio(see above)
+  REAL(r_std)                                           :: stempdiag_bid  !! only needed for an initial LAI in case there is no restart file
+  REAL(r_std), DIMENSION(kjpindex,nbdl)                 :: stempdiag2_bid !! matrix to store stempdiag_bid
+  CHARACTER(LEN=4)                                      :: vegsoil_dist   !! Flag to choose the soil/vegetation distribution
+  !
+  CHARACTER(LEN=30), SAVE                               :: veget_str      !! update frequency for landuse
+  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
+  
+! ==============================================================================
+
+    ! 1 Allocation and initialisation of the different arrays: clayfraction, veget_nextyear,
+    !   frac_nobio_nextyear
+    !
+    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
+
+    ! Initialisation of the fraction of the different vegetation: Start with 100% of bare soil
+    !? (RISKY to have bare soil index fixed to 1)
+    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
+      PRINT *,"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
+      PRINT *,"ERROR IN ALLOCATION of totfrac_nobio_nextyear : ",ier
+      STOP 
+    ENDIF
+    
+    !? 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('UNITS', 'd')
+    CALL ioconf_setatt('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)
+
+    ! get day_counter value from the restart file if none were found in the restart file
+    !?? should be removed : day_counter is already set to zero or correct value in the previous loop
+    CALL setvar_p (day_counter, val_exp, 'SECHIBA_DAY', zero)
+
+
+    ! Read the LAI flag from rundef (to read or not a LAI map)
+    read_lai = .FALSE.
+    CALL getin_p('LAI_MAP',read_lai)
+
+    ! Get the veget variable from the restart file if it is present
+    ! doing the ioconf_setatt to prepare the hist_write, for writing in ncdef files  
+    var_name= 'veget'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Vegetation fraction')
+    CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., veget, "gather", nbp_glo, index_g)
+
+    ! Get the maximum vegetation fraction from the restart file if present
+    var_name= 'veget_max'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('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('UNITS', '-')
+    CALL ioconf_setatt('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)
+
+    ! read the "LAND USE" flag from the run.def file : allows to read (or not) a 
+    ! land_use vegetation map
+    land_use = .FALSE.
+    veget_update=0
+    CALL getin_p('LAND_USE',land_use)
+    IF (land_use) THEN
+       !
+       !Config Key  = VEGET_YEAR
+       !Config Desc = Year of the land_use vegetation map to be read (0 == NO TIME AXIS)
+       !Config If   = LAND_USE
+       !Config Def  = 282
+       !Config Help = First year for landuse vegetation (2D map by pft).
+       !Config Help   If VEGET_YEAR == 0, this means there is no time axis.
+
+
+       !?? 282 : what is this ? code en dur ??
+       veget_year_orig=282
+       CALL getin_p('VEGET_YEAR', veget_year_orig)
+       !
+       !Config Key  = VEGET_REINIT
+       !Config Desc = booleen to indicate that a new LAND USE file will be used.
+       !Config If   = LAND_USE
+       !Config Def  = n
+       !Config Help = The parameter is used to bypass veget_year count 
+       !Config Help   and reinitialize it with VEGET_YEAR parameter.
+       !Config Help   Then it is possible to change LAND USE file.
+       !
+       veget_reinit = .FALSE.
+       CALL getin_p('VEGET_REINIT', veget_reinit)
+       !
+       !
+       var_name= 'veget_year'
+       CALL ioconf_setatt('UNITS', '-')
+       CALL ioconf_setatt('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)
+
+       
+       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
+       !
+       !Config  Key  = LAND_COVER_CHANGE
+       !Config  Desc = treat land use modifications
+       !Config  If   = LAND_USE
+       !Config  Def  = y
+       !Config  Help = With this variable, you can use a Land Use map
+       !Config         to simulate anthropic modifications such as 
+       !Config         deforestation.
+       !
+       lcchange = .TRUE.  
+       CALL getin_p('LAND_COVER_CHANGE', lcchange)
+       IF ( veget_update == 0 .AND. lcchange ) THEN
+          CALL ipslerr (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
+    !
+    var_name= 'soiltype_frac'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('LONG_NAME','Fraction of each soil type')
+    CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., soiltype, "gather", nbp_glo, index_g)
+    !
+    var_name= 'clay_frac'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('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= 'lai'
+    CALL ioconf_setatt('UNITS', '-')
+    CALL ioconf_setatt('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('UNITS', 'm')
+    CALL ioconf_setatt('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('UNITS', '-')
+       CALL ioconf_setatt('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 (m) used for canopy development (if STOMATE disactivated)
+    !Config Def  = 0.5
+    !Config Help = The temperature at this soil depth is used to determine the LAI when
+    !Config        STOMATE is not activated.
+    !
+    zcanop = 0.5_r_std
+    CALL setvar_p (zcanop, val_exp, 'SECHIBA_ZCANOP', 0.5_r_std)
+    !
+    !Config Key  = HYDROL_SOIL_DEPTH
+    !Config Desc = Total depth of soil reservoir
+    !Config Def  = 2.
+    !
+    dpu_cste=2.
+    CALL getin_p ("HYDROL_SOIL_DEPTH", dpu_cste)
+    dpu(:)=dpu_cste
+    !
+    !Config Key  = HYDROL_HUMCSTE
+    !Config Desc = Root profile
+    !Config Def  = 5., .8, .8, 1., .8, .8, 1., 1., .8, 4., 4., 4., 4.
+    !Config Help = Default values were defined for 2 meters soil depth.
+    !Config        For 4 meters soil depth, you may use those ones :
+    !Config        5., .4, .4, 1., .8, .8, 1., 1., .8, 4., 1., 4., 1.
+    !
+    humcste(:)= &
+         & (/5., .8, .8, 1., .8, .8, 1., 1., .8, 4., 4., 4., 4./)
+    CALL getin_p ("HYDROL_HUMCSTE", humcste)
+
+!MM, T. d'O. : before in constantes_soil :
+!          diaglev = &
+!               & (/ 0.001, 0.004, 0.01,  0.018, 0.045, &
+!               &    0.092, 0.187, 0.375, 0.750, 1.5,   &
+!               &    2.0 /)
+       ! Place here because it is used in sechiba and stomate (then in teststomate)
+       ! to be in sechiba when teststomate will have disapeared.
+!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_cste/(2**(nbdl-1) -1) * ( ( 2**(l-1) -1) + ( 2**(l) -1) ) / 2.0
+    ENDDO
+    diaglev(nbdl) = dpu_cste
+
+    ! 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  Def  = 0.1
+    !Config  Help = Transforms leaf area index into size of interception reservoir
+    !Config         for slowproc_derivvar or stomate
+
+    qsintcst = 0.1
+    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  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.
+
+    dt_slow = one_day
+    CALL getin_p('DT_SLOW', dt_slow)
+    !
+
+    !Config Key  = SLOWPROC_LAI_TEMPDIAG
+    !Config Desc = Temperature used for the initial guess of LAI
+    !Config Def  = 280.
+    !Config Help = If there is no LAI in the restart file, we may need
+    !Config        a temperature that is used to guess the initial LAI.
+    !
+    stempdiag_bid = 280.
+    CALL getin_p('SLOWPROC_LAI_TEMPDIAG',stempdiag_bid)
+    ! 
+    !
+    ! get restart value if none were found in the restart file
+    !
+    !Config  Key  = AGRICULTURE
+    !Config  Desc = agriculture allowed?
+    !Config  Def  = y
+    !Config  Help = With this variable, you can determine
+    !Config         whether agriculture is allowed
+    !
+    agriculture = .TRUE.
+    CALL getin_p('AGRICULTURE', agriculture)
+    IF ( .NOT. agriculture .AND. land_use ) THEN 
+       CALL ipslerr (2,'slowproc_init', &
+               &     'Problem with agriculture desactivated and Land Use activated.',&
+               &     'Are you sure ?', &
+               &     '(check your parameters).')
+    ENDIF
+
+    !
+    !Config Key  = IMPOSE_VEG
+    !Config Desc = Should the vegetation be prescribed
+    !Config Def  = n
+    !Config Help = This flag allows the user to impose a vegetation distribution
+    !Config        and its characterisitcs. 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
+    !
+    impveg = .FALSE.
+    CALL getin_p('IMPOSE_VEG', impveg)
+    !
+    IF ( impveg ) THEN
+       !
+       !  We are on a point and thus we can read the information from the run.def
+       !
+       !Config Key  = SECHIBA_VEG
+       !Config Desc = 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.
+       !
+       CALL setvar_p (veget, val_exp, 'SECHIBA_VEG', veget_ori_fixed_test_1)
+
+       !
+       !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.
+       !
+       CALL setvar_p (veget_max, val_exp, 'SECHIBA_VEGMAX', veget_ori_fixed_test_1)
+
+       !
+       !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.
+       !
+     !?? 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.
+       !
+       CALL setvar_p (lai, val_exp, 'SECHIBA_LAI', llaimax)
+
+       !
+       !Config Key  = IMPOSE_SOILT
+       !Config Desc = Should the soil typ 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
+       !
+       impsoilt = .FALSE.
+       CALL getin_p('IMPOSE_SOILT', impsoilt)
+       IF (impsoilt) THEN
+          !Config Key  = SOIL_FRACTIONS
+          !Config Desc = Fraction of the 3 soil types (0-dim mode)
+          !Config Def  = 0.28, 0.52, 0.20
+          !Config If   = IMPOSE_VEG
+          !Config If   = IMPOSE_SOILT
+          !Config Help = Determines the fraction for the 3 soil types
+          !Config        in the mesh in the following order : sand loam and clay.
+          !
+          CALL setvar_p (soiltype, val_exp, 'SOIL_FRACTIONS', soiltype_default)
+
+          !Config Key  = CLAY_FRACTION
+          !Config Desc = Fraction of the clay fraction (0-dim mode)
+          !Config Def  = 0.2
+          !Config If   = IMPOSE_VEG
+          !Config If   = IMPOSE_SOILT
+          !Config Help = Determines the fraction of clay in the grid box.
+          !
+          CALL setvar_p (clayfraction, val_exp, 'CLAY_FRACTION', clayfraction_default)
+       ELSE
+          IF ( MINVAL(soiltype) .EQ. MAXVAL(soiltype) .AND. MAXVAL(soiltype) .EQ. val_exp .OR.&
+               & MINVAL(clayfraction) .EQ. MAXVAL(clayfraction) .AND. MAXVAL(clayfraction) .EQ. val_exp) THEN
+
+             CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, contfrac, soiltype, clayfraction)
+          ENDIF
+       ENDIF
+       !
+       !Config Key  = SLOWPROC_HEIGHT
+       !Config Desc = Height for all vegetation types (m)
+       !Config Def  = 0., 30., 30., 20., 20., 20., 15., 15., 15., .5, .6, 1.0, 1.0
+       !Config If   = IMPOSE_VEG
+       !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.
+       !
+       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
+
+             !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  = FALSE
+             !Config Help = If you want to recover the old (ie orchidee_1_2 branch) 
+             !Config        "interpolation" of vegetation map.
+             !
+             old_veget = .FALSE.
+             CALL getin_p('SLOWPROC_VEGET_OLD_INTERPOL',old_veget)
+
+             ! 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
+                   veget_max(:,2:nvm-2) = zero
+                   DO ji = 1, kjpindex
+                      veget_max(ji,1) = un - SUM(veget_max(ji,nvm-1:nvm)) &
+                           - 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
+                   veget_max(:,2:nvm-2) = zero
+                   DO ji = 1, kjpindex
+                      veget_max(ji,1) = un - SUM(veget_max(ji,nvm-1:nvm)) &
+                           - 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
+                DO ji = 1, kjpindex
+                   veget_max(ji,1) = veget_max(ji,1) + SUM(veget_max(ji,nvm-1:nvm))
+                ENDDO
+                veget_max(ji,nvm-1:nvm) = zero
+             ENDIF
+             !
+          ENDIF
+          !
+       ENDIF
+       !
+       totfrac_nobio(:) = zero
+       DO j = 1, nnobio
+          totfrac_nobio(:) = totfrac_nobio(:) + frac_nobio(:,j)
+       ENDDO
+       !
+       !
+       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  = FALSE
+          !Config Help = If you want to recover the old (ie orchidee_1_2 branch) 
+          !Config        "interpolation" of LAI map.
+          !
+          old_lai = .FALSE.
+          CALL getin_p('SLOWPROC_LAI_OLD_INTERPOL',old_lai)
+
+          !
+          !  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)
+
+          ! Make sure that we redo the computation when we will be back in slowproc_main
+          day_counter = dt_slow - dtradia
+
+       ENDIF
+
+       IF ( MINVAL(veget) .EQ. MAXVAL(veget) .AND. MAXVAL(veget) .EQ. val_exp) THEN
+
+          ! Impose height
+          DO jv = 1, nvm
+             height(:,jv) = height_presc(jv)
+          ENDDO
+
+          ! Have a first guess at the vegetation fraction
+          CALL slowproc_veget (kjpindex, lai, frac_nobio, veget_max, veget)
+
+       ENDIF
+
+       IF ( MINVAL(soiltype) .EQ. MAXVAL(soiltype) .AND. MAXVAL(soiltype) .EQ. val_exp .OR.&
+            & MINVAL(clayfraction) .EQ. MAXVAL(clayfraction) .AND. MAXVAL(clayfraction) .EQ. val_exp) THEN
+
+          CALL slowproc_soilt(kjpindex, lalo, neighbours, resolution, contfrac, soiltype, clayfraction)
+
+       ENDIF
+
+    ENDIF
+    !
+    ! Select the preferences for the distribution of the 13 PFTs on the 3 soil types.
+    !
+    vegsoil_dist='EQUI'
+    !
+    SELECT CASE(vegsoil_dist)
+       !
+       ! A reasonable choice
+       !
+    CASE('MAXR')
+       pref_soil_veg(:,1)  = (/ 1, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 /)
+       pref_soil_veg(:,2)  = (/ 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3 /)
+       pref_soil_veg(:,3)  = (/ 3, 1, 1, 1, 1, 1 ,1 ,1 ,1 ,1 ,1 ,1, 1 /)
+       !
+       ! Current default : equidistribution.
+       !
+    CASE('EQUI')
+       !
+       pref_soil_veg(:,:) = zero
+       !
+    CASE DEFAULT
+       !
+       WRITE(numout,*) 'The vegetation soil type preference you have chosen does not exist'
+       WRITE(numout,*) 'You chose :', vegsoil_dist
+       STOP 'slowproc_init'
+       !
+    END SELECT
+
+
+    ! calculate total fraction of the mesh that is covered by particular surface types: ice, lakes, ...
+    !
+    totfrac_nobio(:) = zero
+    DO jv = 1, nnobio
+       totfrac_nobio(:) = totfrac_nobio(:) + frac_nobio(:,jv)
+    ENDDO
+
+    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 (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)
+    !
+
+ ! 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, veget_max, veget)
+    !
+    ! 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)
+
+
+    ! 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      !! indices 
+    ! Test Nathalie	
+    REAL(r_std)                                            :: SUMveg      !!
+!$    REAL(r_std)                                            :: trans_veg
+! ==============================================================================
+
+    !
+    ! 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
+    !
+    DO jv = 1, nvm
+       DO ji = 1, kjpindex
+          veget(ji,jv) = veget_max(ji,jv)
+       ENDDO
+    ENDDO
+    !
+    ! 3. if lai of a vegetation type (jv > 1) is small, increase soil part
+    !
+    ! Nathalie - nouveau calcul de veget
+!$    DO jv = 1,nvm
+!$       DO ji = 1, kjpindex
+!$
+!$          IF ((jv .GT. 1) .AND. (lai(ji,jv) .LT. 0.5)) THEN
+!$             trans_veg = 2.*(0.5 - lai(ji,jv)) * veget(ji,jv)
+!$             ! We limit the smallest fraction to 0.5%
+!$             IF (  veget(ji,jv) - trans_veg .GT. min_vegfrac ) THEN
+!$                veget(ji,1) = veget(ji,1) + trans_veg
+!$                veget(ji,jv) = veget(ji,jv) - trans_veg
+!$             ELSE
+!$                veget(ji,1) = veget(ji,1) + veget(ji,jv)
+!$                veget(ji,jv) = zero
+!$             ENDIF
+!$          ENDIF
+!$
+!$       ENDDO
+!$    ENDDO
+    ! Added a new scheme of computation 
+    DO ji = 1, kjpindex
+       SUMveg = zero
+       veget(ji,1) = veget_max(ji,1)
+       DO jv = 2, nvm
+          veget(ji,jv) = veget_max(ji,jv) * ( un - exp( - lai(ji,jv) * ext_coef(jv) ) )
+          veget(ji,1) = veget(ji,1) + (veget_max(ji,jv) - veget(ji,jv))
+          SUMveg = SUMveg + veget(ji,jv)
+       ENDDO
+       SUMveg = SUMveg + veget(ji,1) + 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,:)
+       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 jv = 1, nvm
+          DO ji = 1, kjpindex
+             IF ( ABS(fracsum(ji)-un) .GT. EPSILON(un) ) THEN
+                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
+
+  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 
+! ==============================================================================
+
+    
+    ! Test Nathalie. On impose LAI PFT 1 a 0
+    ! Set LAI for PFT no.1 to be zero  
+    lai(: ,1) = zero
+
+    ! Interpolation of lai between the laimin and laimax values.
+    DO jv = 2,nvm 
+!$     DO jv = 1,nvm
+
+       SELECT CASE (type_of_lai(jv))
+
+       CASE ("mean ")
+          !
+          ! 1. In case lai is not read from the laimap, the lai is computed as the mean of laimax and laimin of a PFT.  
+          !
+          IF ( .NOT. read_lai ) THEN
+             lai(:,jv) = undemi * (llaimax(jv) + llaimin(jv))
+          ELSE
+             DO ji = 1,kjpindex
+                lai(ji,jv) = MAXVAL(laimap(ji,jv,:))
+             ENDDO
+          ENDIF
+          !
+       CASE ("inter")
+          !
+          ! 2. do the interpolation between laimax and laimin
+          !
+          IF ( .NOT. read_lai ) THEN
+             DO ji = 1,kjpindex
+                lai(ji,jv) = llaimin(jv) + tempfunc(stempdiag(ji,lcanop)) * (llaimax(jv) - llaimin(jv))
+             ENDDO
+          ELSE
+             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
+             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
+                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
+          ENDIF
+          !
+       CASE default
+          !
+          ! 3. Problem occurs then the routine stops 
+          !
+          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
+
+  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
+    !
+    REAL(r_std), PARAMETER                          :: min_sechiba=1.E-8
+    !
+    !
+    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, pi
+    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
+
+! ==============================================================================
+    !
+    pi = 4. * ATAN(1.)
+    !
+    !Config Key  = LAI_FILE
+    !Config Desc = Name of file from which the vegetation map is to be read
+    !Config If   = !LAI_MAP
+    !Config Def  = ../surfmap/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. 
+    !
+    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. ), 0.001 )*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
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    !
+    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 ::           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  = ../surfmap/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. 
+    !
+    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)
+    !
+    !
+    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
+    !
+    !
+    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(:,:) = 1
+    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 (ABS(SUM(laimap_lu(ip,jp,:,:))) < EPSILON(laimap_lu) ) THEN
+!$             mask(ip,jp) = 0
+!$          ENDIF
+          !
+          IF ( ANY(laimap_lu(ip,jp,:,:) < 20.) ) THEN
+             mask(ip,jp) = 1
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    nbvmax = 20
+    !
+    callsign = 'LAI 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, 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
+          
+!$          IF ( ANY( laimap(ib,:,:) > 10 ) ) THEN
+!$             WRITE(numout,*) "For point ",ib
+!$             WRITE(numout,*) lalo(ib,1), lalo(ib,2)
+!$             WRITE(numout,*) "For ib=",ib," we have LAI ",laimap(ib,:,1:idi)
+!$             WRITE(numout,*) "Detail of projection :" 
+!$             WRITE(numout,*) sub_area(ib,1:idi)
+!$             WRITE(numout,*) "Total for projection :" ,totarea
+!$          ENDIF
+          !
+       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
+    !
+    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)
+    !
+    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
+!_ ================================================================================================================================
+
+!MM modif TAG 1.4 : 
+!  SUBROUTINE slowproc_update(nbpt, lalo,  resolution, vegetmap, frac_nobiomap)
+!MM modif TAG 1.9.2 : 
+!  SUBROUTINE slowproc_update(nbpt, lalo, neighbours,  resolution, contfrac, vegetmax, frac_nobio, veget_year, init)
+  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 !)
+!MM modif TAG 1.4 : add grid variables for aggregate
+    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
+    !
+!MM modif TAG 1.4 : suppression of all time axis reading and interpolation, replaced by each year 2D reading.
+!    REAL(r_std), INTENT(inout)    ::  vegetmap(nbpt,nvm,293)         ! vegetfrac read variable and re-dimensioned
+!    REAL(r_std), INTENT(inout)    ::  frac_nobiomap(nbpt,nnobio,293) ! Fraction of the mesh which is covered by ice, lakes, ...
+    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  = pft_new.nc
+    !Config Help = The name of the file to be opened to read a vegetation
+    !Config        map (in pft) is to be given here. 
+    !
+    filename = 'pft_new.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
+       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)
+
+    IF (lml /= nvm) &
+         CALL ipslerr (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 (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 (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
+          idi=1
+          sumf=zero
+          DO WHILE ( sub_area(ib,idi) > zero ) 
+             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)
+             idi = idi +1
+          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 (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., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0. /)
+                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(*,*) "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
+          !
+          idi=1
+          sumf=zero
+          DO WHILE ( sub_area(ib,idi) > zero ) 
+             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)
+             idi = idi +1
+          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 (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 (3,'slowproc_update', &
+             CALL ipslerr (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 (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 (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
+    !
+    REAL(r_std), PARAMETER                          :: min_sechiba=1.E-8
+    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, pi
+    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
+! ==============================================================================
+    !
+    pi = 4. * ATAN(1.)
+    !
+    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   = !IMPOSE_VEG
+    !Config Def  = ../surfmap/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.
+    !
+    filename = '../surfmap/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. ), 0.001 )*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
+    !
+    INTEGER                  :: ALLOC_ERR
+! ==============================================================================\n
+    !
+    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   = !IMPOSE_VEG
+    !Config If   = !LAND_USE
+    !Config Def  = ../surfmap/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.
+    !
+    filename = '../surfmap/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 should
+    ! also be computed and not imposed here.
+    nbvmax = iml/nbpt
+    !
+    callsign="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), 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, 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
+             idi=1
+             DO WHILE ( sub_area(ib,idi) > zero ) 
+                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)
+                idi = idi +1
+             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
+    !
+    REAL(r_std), PARAMETER                          :: min_sechiba=1.E-8
+    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, pi
+    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
+! ==============================================================================
+    !
+    pi = 4. * ATAN(1.)
+    !
+    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   = !IMPOSE_VEG
+    !Config Def  = ../surfmap/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.
+    !
+    filename = '../surfmap/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. ), 0.001 )*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                  :: 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   = !IMPOSE_VEG
+    !Config If   = !LAND_USE
+    !Config Def  = ../surfmap/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.
+    !
+    filename = '../surfmap/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)
+    !
+    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 should
+    ! also be computed and not imposed here.
+    nbvmax = iml/nbpt
+    !
+    callsign="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), 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
+             idi=1
+                ! TL : idi = parcourt les points de la vegetation map inclus dans la grille du GCM 
+                ! ib = parcourt les points de grille
+                ! y a-t-il un tri preliminaire de sub_area ? sinon, si sub_area(ib,2)=0 et sub_area(ib,3)>0 alors on a 
+                ! quitte boucle et on ne prend pas compte le point quand idi=3
+             DO WHILE ( sub_area(ib,idi) > zero ) 
+                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)
+                idi = idi +1
+             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)                                  :: pi   
+    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
+
+    pi = 4.0 * ATAN(1.0)  !! TL : correct
+
+    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
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE slowproc_soilt(nbpt, lalo, neighbours, resolution, contfrac, soiltype, clayfraction)
+    !
+    !
+    !   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)      :: soiltype(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
+    !
+    !
+    !  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, soiltext
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)  :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: solt
+    REAL(r_std) ::  sgn
+    CHARACTER(LEN=30) :: callsign
+    !
+    ! Number of texture classes in Zobler
+    !
+    INTEGER(i_std), PARAMETER :: classnb = 7
+    REAL(r_std)               :: textfrac_table(classnb, nstm)
+    !   
+    LOGICAL                  :: ok_interpol  ! optionnal return of aggregate_2d
+    !   
+    INTEGER                  :: ALLOC_ERR
+! ==============================================================================
+    !
+    !
+    CALL get_soilcorr (classnb, textfrac_table)
+    !
+    !  Needs to be a configurable variable
+    !
+    !
+    !Config Key  = SOILTYPE_FILE
+    !Config Desc = Name of file from which soil types are read
+    !Config Def  = ../surfmap/soils_param.nc
+    !Config If   = !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.
+    !
+    filename = '../surfmap/soils_param.nc'
+    CALL getin_p('SOILTYPE_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
+    !
+    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 (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
+       ENDDO
+    ENDDO
+    !
+    nbvmax = 200
+    !
+    callsign = "Soil types"
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       WRITE(numout,*) "Projection arrays for ",callsign," : "
+       WRITE(numout,*) "nbvmax = ",nbvmax
+       !
+       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(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)
+          !
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    !
+    DO ib =1, nbpt
+       !
+       soiltype(ib,:) = zero
+       clayfraction(ib) = zero
+       !
+       ! GO through the point we have found
+       !
+       !
+       fopt = COUNT(sub_area(ib,:) > zero)
+       !
+       !    Check that we found some points
+       !
+       IF ( fopt .EQ. 0) THEN
+          nbexp = nbexp + 1
+          soiltype(ib,:) = soiltype_default(:)
+          clayfraction(ib) = clayfraction_default
+       ELSE
+          !
+          DO ilf = 1,fopt
+             solt(ilf) = soiltext(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. classnb) .AND. (solt(ilf) .GT. 0) .AND.&
+                  & (solt(ilf) .NE. 6)) THEN
+                SELECTCASE(solt(ilf))
+                CASE(1)
+                   soiltype(ib,1) = soiltype(ib,1) + sub_area(ib,ilf)
+                CASE(2)
+                   soiltype(ib,2) = soiltype(ib,2) + sub_area(ib,ilf)
+                CASE(3)
+                   soiltype(ib,2) = soiltype(ib,2) + sub_area(ib,ilf)
+                CASE(4)
+                   soiltype(ib,2) = soiltype(ib,2) + sub_area(ib,ilf)
+                CASE(5)
+                   soiltype(ib,3) = soiltype(ib,3) + sub_area(ib,ilf)
+                CASE(7)
+                   soiltype(ib,2) = soiltype(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)
+                sgn = sgn + sub_area(ib,ilf)
+             ELSE
+                IF (solt(ilf) .GT. classnb) 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
+             soiltype(ib,:) = soiltype_default(:)
+             clayfraction(ib) = clayfraction_default
+          ELSE
+             soiltype(ib,:) = soiltype(ib,:)/sgn
+             clayfraction(ib) = clayfraction(ib)/sgn
+          ENDIF
+          !
+       ENDIF
+       !
+    ENDDO
+    !
+    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 (solt)
+    !
+    !
+    RETURN
+    !
+  END SUBROUTINE slowproc_soilt
+    !
+
+
+END MODULE slowproc
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/thermosoil.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/thermosoil.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/thermosoil.f90	(revision 854)
@@ -0,0 +1,1548 @@
+! =================================================================================================================================
+! 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
+
+  USE ioipsl
+  
+  ! modules used :
+  USE constantes
+  USE constantes_soil
+  USE sechiba_io
+  USE grid
+  USE parallel
+
+  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)
+  CHARACTER(LEN=80) , SAVE                        :: var_name                 !! To store variables names for the 
+                                                                              !! input-outputs dealt with by IOIPSL
+  REAL(r_std), SAVE                               :: lambda, cstgrnd, lskin   !! See Module description
+  REAL(r_std), SAVE                               :: fz1, zalph               !! usefull constants for diverse use
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ptn                      !! vertically discretized 
+                                                                              !! soil temperatures @tex ($K$) @endtex. 
+  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.
+  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.
+  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.
+  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
+  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.
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: cgrnd                    !! integration coefficient for the numerical scheme,
+                                                                              !! see eq.1
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dgrnd                    !! integration coefficient for the numerical scheme,
+                                                                              !! see eq.1
+  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.
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pkappa                   !! vertically discretized soil thermal conductivity 
+                                                                              !!  @tex ($W K^{-1} m^{-1}$) @endtex. Same as pcapa.
+  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 
+  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
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: pcapa_en                 !! heat capacity used for surfheat_incr and 
+                                                                              !! coldcont_incr 
+  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.
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: temp_sol_beg             !! Surface temperature at the beginning of the 
+                                                                              !! timestep  @tex ($K$) @endtex
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: surfheat_incr            !! Change in soil heat content during the timestep 
+                                                                              !!  @tex ($J$) @endtex.
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:)   :: coldcont_incr            !! Change in snow heat content  @tex ($J$) @endtex.
+  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.
+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, 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..)
+    
+    !! 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
+!_ ================================================================================================================================
+    
+  !! 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)
+
+        
+        !! 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('UNITS', '-')
+           CALL ioconf_setatt('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('UNITS', '-')
+           CALL ioconf_setatt('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('UNITS', '-')
+           CALL ioconf_setatt('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('UNITS', '-')
+           CALL ioconf_setatt('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('UNITS', '-')
+           CALL ioconf_setatt('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('UNITS', '-')
+           CALL ioconf_setatt('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('UNITS', '-')
+           CALL ioconf_setatt('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('UNITS', '-')
+           CALL ioconf_setatt('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('UNITS', 'K')
+           CALL ioconf_setatt('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)
+
+    
+  !! 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(hist_id, 'ptn', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+    ELSE
+      CALL histwrite(hist_id, 'SoilTemp', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+      CALL histwrite(hist_id, 'Qg', kjit, soilflx, kjpindex, index)
+      CALL histwrite(hist_id, 'DelSurfHeat', kjit, surfheat_incr, kjpindex, index)
+      CALL histwrite(hist_id, 'DelColdCont', kjit, coldcont_incr, kjpindex, index)
+    ENDIF
+    IF ( hist2_id > 0 ) THEN
+       IF ( .NOT. almaoutput ) THEN
+          CALL histwrite(hist2_id, 'ptn', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+       ELSE
+          CALL histwrite(hist2_id, 'SoilTemp', kjit, ptn, kjpindex*ngrnd, indexgrnd)
+          CALL histwrite(hist2_id, 'Qg', kjit, soilflx, kjpindex, index)
+          CALL histwrite(hist2_id, 'DelSurfHeat', kjit, surfheat_incr, kjpindex, index)
+          CALL histwrite(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)
+
+    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
+!_ ================================================================================================================================
+
+  !! 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('UNITS', 'K')
+        CALL ioconf_setatt('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 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.
+!
+        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)
+
+  !! 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) 
+    
+    !! 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
+    REAL(r_std)                                              :: sum
+!_ ================================================================================================================================
+
+  !! 1. Initialization of the parameters of the vertical discretization and of the attenuation depths
+    
+    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)
+
+    !! 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
+    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)
+  
+  !! 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.
+    
+    !! 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), SAVE, ALLOCATABLE, DIMENSION(:,:)       :: intfactw     !! fraction of each diagnostic layer (jd) comprized within
+                                                                         !! a given thermal layer (jg)(0-1, unitless) 
+    LOGICAL, PARAMETER :: check=.FALSE.
+!_ ================================================================================================================================
+    
+  !! 1. computes intfactw(jd,jg), the fraction of each diagnostic layer (jg) comprized within a given thermal layer (jd)
+
+    IF ( .NOT. ALLOCATED(intfactw)) THEN
+        
+        ALLOCATE(intfactw(ngrnd, nbdl))
+        
+        prev_diag = zero
+        DO jd = 1, ngrnd
+          lev_diag = prev_diag + dz2(jd)
+          prev_prog = zero
+          DO jg = 1, nbdl
+             IF ( jg == nbdl .AND. diaglev(jg) < lev_diag ) THEN
+                lev_prog = lev_diag
+             ELSE
+                lev_prog = diaglev(jg)
+             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
+        
+        IF ( check ) THEN
+           WRITE(numout,*) 'thermosoil_humlev -- thermosoil_humlev -- thermosoil_humlev --' 
+           DO jd = 1, ngrnd
+              WRITE(numout,*) jd, '-', intfactw(jd,1:nbdl)
+           ENDDO
+           WRITE(numout,*) "SUM -- SUM -- SUM SUM -- SUM -- SUM"
+           DO jd = 1, ngrnd
+              WRITE(numout,*) jd, '-', SUM(intfactw(jd,1:nbdl))
+           ENDDO
+           WRITE(numout,*) 'thermosoil_humlev -- thermosoil_humlev -- thermosoil_humlev --' 
+        ENDIF
+        
+    ENDIF
+
+  !! 2. does the interpolation
+
+    wetdiag(:,:) = zero
+    DO jg = 1, nbdl
+      DO jd = 1, ngrnd
+        DO ji = 1, kjpindex
+          wetdiag(ji,jd) = wetdiag(ji,jd) + shumdiag(ji,jg)*intfactw(jd,jg)
+        ENDDO
+      ENDDO
+    ENDDO
+
+  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: perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/watchout.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/watchout.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_sechiba/watchout.f90	(revision 854)
@@ -0,0 +1,2257 @@
+MODULE watchout
+
+  USE defprec
+  USE parallel
+  USE constantes
+  USE netcdf
+
+  PRIVATE
+  PUBLIC :: watchout_init, watchout_write_p, watchout_close
+!watchout_write ??
+
+  LOGICAL,SAVE,PUBLIC             :: ok_watchout = .FALSE.
+  REAL, SAVE,PUBLIC               :: dt_watch = zero
+  INTEGER, SAVE,PUBLIC            :: last_action_watch = 0, &
+       & last_check_watch = 0
+  CHARACTER(LEN=80),SAVE, PUBLIC   :: 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
+  INTEGER(i_std),SAVE      :: watchfid, zlevid, soldownid, rainfid, snowfid, lwradid, &
+       & psolid, tairid, eairid, qairid, uid, vid, &
+       & solnetid, petAcoefid, peqAcoefid, petBcoefid, peqBcoefid, cdragid, ccanopyid
+  INTEGER(i_std),SAVE      :: watchoffset
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_zlev
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_u, sum_v
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_qair
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_temp_air
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_epot_air
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_ccanopy
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_cdrag
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_petAcoef, sum_peqAcoef, sum_petBcoef, sum_peqBcoef
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_rain, sum_snow
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_lwdown
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_swnet
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: sum_swdown
+  REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE, PUBLIC  :: 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), PUBLIC :: dt_split_watch
+  !! mean julian time for each time step
+  REAL(r_std), PUBLIC :: 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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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
+    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
+    !
+    LOGICAL, SAVE                          :: is_first_time=.TRUE.
+    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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (3,'watchout_close','Could not close the file : ', &
+ &          TRIM(watchout_file),'(Solution ?)')
+    ENDIF
+    !
+  END SUBROUTINE watchout_close
+
+END MODULE watchout
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/AA_make
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/AA_make	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/AA_make	(revision 854)
@@ -0,0 +1,217 @@
+#-
+#- $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_constants.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
+#-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)(constantes_co2.o)  \
+  $(MODEL_LIB)(stomate_io.o)      \
+  $(MODEL_LIB)(stomate_lpj.o)
+
+$(MODEL_LIB)(stomate_constants.o): \
+  $(PARAM_LIB)(constantes_veg.o)
+
+$(MODEL_LIB)(lpj_constraints.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(lpj_cover.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(lpj_crown.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(lpj_establish.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(lpj_fire.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(lpj_gap.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(lpj_kill.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(lpj_light.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(lpj_pftinout.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_alloc.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_data.o):     \
+  $(PARAM_LIB)(constantes_co2.o)  \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_io.o): \
+  $(MODEL_LIB)(stomate_constants.o) \
+  $(PARALLEL_LIB)(parallel.o)
+
+$(MODEL_LIB)(stomate_litter.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_npp.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_phenology.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_prescribe.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_resp.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_season.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_soilcarbon.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_turnover.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_vmax.o): \
+  $(MODEL_LIB)(stomate_constants.o)
+
+$(MODEL_LIB)(stomate_assimtemp.o): \
+  $(MODEL_LIB)(stomate_constants.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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/AA_make.ldef
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/AA_make.ldef	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/AA_make.ldef	(revision 854)
@@ -0,0 +1,18 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Creation des elements relatifs a STOMATE
+#---------------------------------------------------------------------
+SHELL = /bin/sh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_constraints.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_constraints.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_constraints.f90	(revision 854)
@@ -0,0 +1,247 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC constraints,constraints_clear
+
+  LOGICAL, SAVE                           :: firstcall = .TRUE.      !! first call
+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), PARAMETER                          :: too_long = 5.   !! Longest sustainable time without regeneration (years)
+    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) = 1. 
+
+          !! 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 ( tree(j) .AND. ( pheno_crit%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) = 1. 
+
+          !! 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 (hist_id_stomate, 'ADAPTATION', itime, &
+         adapted, npts*nvm, horipft_index)
+    CALL histwrite (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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_cover.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_cover.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_cover.f90	(revision 854)
@@ -0,0 +1,346 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  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, veget, lai, litter, carbon, turnover_daily, bm_to_litter)
+
+!! 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 
+                                                                                    !! step (unitless)
+
+    !! 0.2 Output variables
+  
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)             :: veget            !! Fractional coverage on ground, taking into 
+                                                                                    !! account LAI (=grid-scale fpc) (unitless)
+    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,nlevs), INTENT(inout) :: litter           !! Metabolic and structural litter, above and 
+                                                                                    !! below ground @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(inout)       :: carbon           !! Carbon pool: active, slow, or passive 
+                                                                                    !! @tex $(gC m^{-2})$ @endtex
+
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts), 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), INTENT(inout)      :: turnover_daily   !! Turnover rates (gC m^{-2} day^{-1})
+    REAL(r_std), DIMENSION(npts,nvm,nparts), 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,nlevs)                    :: dilu_lit         !! Litter dilution @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,ncarb)                          :: 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)
+!_ ================================================================================================================================
+
+ !! 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
+       sum_vegettree(:) = zero
+       sum_vegetgrass(:) = 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.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(i,:,:) = zero
+          dilu_soil_carbon(i,:) = zero
+          DO j=1, nvm ! loop over PFTs
+             IF ( delta_veg(j) < -min_stomate ) THEN 
+                dilu_lit(i,:,:)=  dilu_lit(i,:,:) + delta_veg(j)*litter(i,:,j,:) / delta_veg_sum
+                dilu_soil_carbon(i,:)=  dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum
+             ENDIF
+          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(i,:,j,:)=(litter(i,:,j,:) * veget_max_old(i,j) + dilu_lit(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
+       ENDDO ! loop over grid points
+    ENDIF
+
+    
+  !! 2. Calculate LAI
+
+    !   The LAI is defined on the space covered by the crown of the plant.
+    !   ( biomass / veget_max ) is in gC m^{-2} covered by the crown)
+    !   MM in Soenke code but not in merge version ; must keep that ??
+    !   NV, MM : we keep those comments for compatibility with CMIP5 computations.
+    ! They have to be uncommented avec CMIP5 versions in the trunk !
+!$    DO j = 2,nvm
+!$       lai(:,j) = biomass(:,j,ileaf,icarbon)*sla(j)
+!$    ENDDO
+    
+  !! 3. Calculate grid-scale foliage projected cover (::fpc)
+    
+    !! 3.1   Obtain the shaded ground area by leaf's light capture
+    DO j = 2,nvm ! loop over PFTs
+       DO i = 1, npts ! loop over grid points
+          IF (lai(i,j) == val_exp) THEN               
+             veget(i,j) = veget_max(i,j)
+          ELSE
+             IF ( control%ok_dgvm ) THEN
+             
+             !$SZneed to check this - this formulation will cause 100% veget, otherwise there will always 
+             !$ be some percent bare ground
+                veget(i,j) = ind(i,j) * cn_ind(i,j)  * ( un - EXP( - lai(i,j) * ext_coeff(j) ) )
+             ELSE
+                veget(i,j) = veget_max(i,j) * ( un - EXP( - lai(i,j) * ext_coeff(j) ) )
+             ENDIF
+          ENDIF
+
+          ! check sums of fpc for natural vegetation (see correction below!) in dynamic mode
+          IF ( control%ok_dgvm ) THEN
+
+             IF(natural(j))THEN
+                IF(tree(j)) THEN
+                   sum_vegettree(i)=sum_vegettree(i)+veget(i,j)
+                ELSE 
+                   sum_vegetgrass(i)=sum_vegetgrass(i)+veget(i,j)
+                ENDIF
+             ENDIF
+
+          ENDIF
+       ENDDO ! loop over grid points
+    ENDDO ! loop over PFTs
+
+    !! 3.2 Correct gridscale fpc for dynamic vegetation
+    
+    !$SZ, this part should be obsolete now that veget_max is forced to 1.0
+    !$ nevertheless maintained just for safety. Whoever wants to test
+    !$ whether this works without is invited to do so.
+
+    ! in the DGVM mode, we can arrive at a sum of veget slighly exceeding 1.0,
+    ! because mainly of grass dynamics...
+    ! In this case, we divide the fpar over natural vegetation first such that 
+    ! grasses are shadowed by trees, and in the theoretically impossible case that
+    ! this is not sufficient, reduce proportionally all veget's.
+    
+    IF ( control%ok_dgvm ) THEN
+
+       DO i = 1,npts ! loop over grid points
+
+          diff=sum_vegettree(i)+sum_vegetgrass(i)-frac_nat(i)
+          reduct(:) = 0.
+          
+          ! ordinary case, the reason too much grasses 
+          ! reduce grass veget to match the maximum
+          IF (diff .GT. 0. ) THEN
+
+             IF (sum_vegetgrass(i).GT.min_stomate) THEN
+                sr=0.
+                DO j=2,nvm ! loop over PFTs
+                   IF(natural(j).AND..NOT.tree(j)) THEN
+                      reduct(j)=-MIN(diff,sum_vegetgrass(i))*veget(i,j)/sum_vegetgrass(i)
+                      sr=sr+reduct(j)
+                   ENDIF
+                ENDDO ! loop over PFTs
+                diff=diff+sr
+             ENDIF
+
+          ENDIF
+
+          ! this is theoretically impossible, since trees can only occupy 95%,
+          ! but better be save than sorry
+          IF (diff .GT. min_stomate ) THEN
+
+             IF (sum_vegettree(i).GT.min_stomate) THEN
+                sr=0.
+                DO j=2,nvm ! loop over PFTs
+                   IF(natural(j).AND.tree(j)) THEN
+                      reduct(j)=-MIN(diff,sum_vegettree(i))*veget(i,j)/sum_vegettree(i)
+                      sr=sr+reduct(j)
+                   ENDIF
+                ENDDO ! loop over PFTs
+                diff=diff+sr 
+             ENDIF
+
+          ENDIF
+
+!$          ! tell user if the problem could not be resolved
+!$          ! in theory the model should stop here!
+!$          IF (diff .GT. min_stomate ) THEN
+!$
+!$             write(numout,*) 'ATT, DGVM!: veget exceeds bareground without vegetation left'
+!$             write(numout,*) 'ATT, DGVM!: is this a bug? cell: ',i
+!$             write(numout,*) 'ATT, DGVM!: veget ',veget(i,:)
+!$
+!$          ENDIF
+
+          ! finally, implement the reduction. (reduc is negative!)
+          veget(i,:)=veget(i,:)+reduct(:)
+
+       ENDDO ! loop over grid points
+
+    ENDIF
+
+    !! 3.3 Calculate fractional coverage by bare-ground as subtracting vegetated fraction from 1.0
+    veget(:,ibare_sechiba) = un
+    DO j = 2,nvm ! loop over PFTs
+       veget(:,ibare_sechiba) = veget(:,ibare_sechiba) - veget(:,j)
+    ENDDO ! loop over PFTs
+
+  END SUBROUTINE cover
+
+END MODULE lpj_cover
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_crown.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_crown.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_crown.f90	(revision 854)
@@ -0,0 +1,200 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+  
+  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),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 
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(inout)     :: height          !! Height of vegetation (m)                                                                     !! infinity) on ground (unitless)
+
+    !! 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 (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)+biomass(:,j,isapbelow) &
+                !$ &         +biomass(:,j,iheartabove)+biomass(:,j,iheartbelow))/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))**1.6
+
+             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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_establish.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_establish.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_establish.f90	(revision 854)
@@ -0,0 +1,760 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC establish,establish_clear
+
+  LOGICAL, SAVE                          :: firstcall = .TRUE.           !! first call
+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), 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)                              :: 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(:) = 1.
+
+       !! 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(:) & 
+                        * ( 1. - exp( - lm_lastyearmax(:,j) * sla(j) * ext_coeff(j) ) )
+                ENDWHERE
+             ENDWHERE
+
+             WHERE ( PFTpresent(:,j) )
+                sumfpc(:) = sumfpc(:) + fpc_nat(:,j)
+             ENDWHERE
+          ELSE
+
+             fpc_nat(:,j) = 0.0
+
+          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 ( 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. 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_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(:)=(1.0-exp(-5.0*(1.0-sumfpc_wood(:))))*(1.0-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(:),0.98-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.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), 1._r_std )
+
+                   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 ( 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(:,:) = 0.0
+
+       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(:)=0.0
+          ENDWHERE
+
+          !! 3.1 For natural woody PFTs
+          IF ( natural(j) .AND. tree(j)) THEN 
+
+             ! See Eq. (4) in tex file.
+             fpc_nat(:,j) =  MIN(1.0,cn_ind(:,j) * ind(:,j) * & 
+                  MAX( ( 1._r_std - 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(:)=(1.0-exp(-5.0*(1.0-fpc_nat(:,j))))*(1.0-fpc_nat(:,j))
+
+                estab_rate_max_tree(:) = estab_max_tree * factor(:) 
+
+                !! 3.1.2 do establishment for natural PFTs\n
+                d_ind(:,j) = MAX( 0.0, 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.0.0)
+                d_ind(:,j) = ind_0*10.
+             ENDWHERE
+
+          !! 3.2 For natural grass PFTs
+          ELSEIF ( natural(j) .AND. .NOT.tree(j)) THEN 
+
+             WHERE (veget_max(:,j).GT.min_stomate)
+
+                fpc_nat(:,j) =  cn_ind(:,j) * ind(:,j) * & 
+                     MAX( ( 1._r_std - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
+
+                d_ind(:,j) = MAX(0.0 , (1.0-fpc_nat(:,j)) * dt/one_year )
+
+             ENDWHERE
+
+             WHERE (veget_max(:,j).GT.min_stomate.AND.ind(:,j).EQ.0.0)
+                d_ind(:,j) = ind_0*10.
+             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)
+
+          ! 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)
+          ENDDO
+          IF(control%ok_dgvm) THEN
+             vn(:)=veget_max(:,j)
+          ELSE
+             vn(:)=1.0
+          ENDIF
+          total_bm_sapl(:)=zero
+          DO k = 1, nparts
+             WHERE(d_ind(:,j).GT.min_stomate.AND.vn(:).GT.min_stomate)
+
+                total_bm_sapl(:) = total_bm_sapl(:) + & 
+                     bm_sapl(j,k) * 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(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)+biomass(i,j,isapbelow) &
+                              & +biomass(i,j,iheartabove)+biomass(i,j,iheartbelow))*veget_max(i,j)) &
+                              & +(bm_sapl(j,isapabove)+bm_sapl(j,isapbelow) &
+                              & +bm_sapl(j,iheartabove)+bm_sapl(j,iheartbelow))*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)+biomass(i,j,isapbelow) &
+                              & +biomass(i,j,iheartabove)+biomass(i,j,iheartbelow))*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))**1.6
+
+                   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(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)+biomass(i,j,isapbelow) &
+                           & +biomass(i,j,iheartabove)+biomass(i,j,iheartbelow))) &
+                           & +(bm_sapl(j,isapabove)+bm_sapl(j,isapbelow) &
+                           & +bm_sapl(j,iheartabove)+bm_sapl(j,iheartbelow))*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)+biomass(i,j,isapbelow) &
+                           & +biomass(i,j,iheartabove)+biomass(i,j,iheartbelow)) &
+                           & /(ind(i,j)+d_ind(i,j))
+
+                   ENDIF
+                ENDIF
+             ENDDO ! Loop over # pixels - domain size
+
+             vn(:)=1.0 ! 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(:) = total_bm_sapl(:) + & 
+                     bm_sapl(j,k) * 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) / vn(:)
+
+                biomass(:,j,k) = biomass(:,j,k) + 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(:) * biomass(:,j,k) / total_bm_c(:)
+
+                biomass(:,j,k) = biomass(:,j,k) + 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) .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) )
+
+          ENDWHERE
+
+          leaf_mass_young(:) = leaf_mass_young(:) + d_ind(:,j) * bm_sapl(j,ileaf)   
+
+          !! 4.7 Youngest class: new mass in youngest class divided by total new mass
+          WHERE ( biomass(:,j,ileaf) .GT. min_stomate )
+             ! new age class fractions (fraction in youngest class increases)
+             leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf)
+
+          ENDWHERE
+
+          !! 4.8 Other classes: old mass in leaf age class divided by new mass
+          DO m = 2, nleafages
+
+             WHERE ( biomass(:,j,ileaf) .GT. min_stomate )
+
+                leaf_frac(:,j,m) = leaf_frac(:,j,m) * & 
+                     ( biomass(:,j,ileaf) + d_ind(:,j) * bm_sapl(j,ileaf) ) /  biomass(:,j,ileaf)
+
+             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 ( tree(j) ) THEN
+
+             sm2(:)=biomass(:,j,isapabove) + biomass(:,j,isapbelow)
+
+             WHERE ( ( d_ind(:,j) .GT. min_stomate ) .AND. &
+                  ( biomass(:,j,isapabove) + biomass(:,j,isapbelow) ) .GT. sm2(:) ) !!?? l.h.s. equals r.h.s ?
+
+                !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) = biomass(:,j,iheartabove) + &
+                     ( biomass(:,j,isapabove) - sm2(:) * sm_at(:) )
+                biomass(:,j,isapabove) = sm2(:) * sm_at(:)
+
+                biomass(:,j,iheartbelow) = biomass(:,j,iheartbelow) + &
+                     ( biomass(:,j,isapbelow) - sm2(:) * (un - sm_at) )
+                biomass(:,j,isapbelow) = sm2(:) * (un - sm_at(:))
+
+             ENDWHERE
+
+          ENDIF ! tree
+
+       ENDIF ! natural
+
+    ENDDO ! Loop over # PFTs
+
+  !! 5. history
+
+    d_ind = d_ind / dt
+
+    CALL histwrite (hist_id_stomate, 'IND_ESTAB', itime, d_ind, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'ESTABTREE', itime, estab_rate_max_tree, npts, hori_index)
+    CALL histwrite (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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_fire.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_fire.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_fire.f90	(revision 854)
@@ -0,0 +1,602 @@
+! =================================================================================================================================
+! 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 ioipsl
+  USE stomate_constants
+  USE constantes_veg
+  USE parallel 
+  
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC fire,fire_clear
+
+  
+  LOGICAL, SAVE                   :: firstcall = .TRUE.        !! first call 
+  LOGICAL, SAVE                   :: disable_fire              !! flag that disables fire
+
+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.
+!! 
+!! 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
+!!
+!! FLOWCHART     : None
+!! \n 
+!_ ================================================================================================================================
+  
+  SUBROUTINE fire (npts, dt, litterpart, &
+       litterhum_daily, t2m_daily, lignin_struc, &
+       fireindex, firelitter, biomass, ind, &
+       litter, dead_leaves, bm_to_litter, black_carbon, &
+       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,nlevs), INTENT(in)           :: lignin_struc        !! Ratio Lignin/Carbon in structural above 
+                                                                                        !! and below ground litter 
+                                                                                        !! @tex $(gC gC^{-1})$ @endtex 
+
+    !! 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), 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,nlevs), INTENT(inout)  :: litter              !! 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), 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
+    
+    !! 0.4 Local variables
+
+    REAL(r_std), PARAMETER                                        :: tau_fire = 30.     !! Time scale for memory of the fire 
+                                                                                        !! index (days)
+    REAL(r_std), PARAMETER                                        :: litter_crit = 200. !! Critical litter quantity for fire 
+                                                                                        !! below which iginitions extinguish 
+                                                                                        !! @tex $(gC m^{-2})$ @endtex
+    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), SAVE, DIMENSION(nparts)                          :: co2frac            !! The fraction of the different biomass 
+                                                                                        !! compartments emitted to the atmosphere 
+                                                                                        !! when burned (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_above       !! 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              !! 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. 
+       co2frac(ileaf) = .95
+       co2frac(isapabove) = .95
+       co2frac(isapbelow) = 0.
+       co2frac(iheartabove) = 0.3
+       co2frac(iheartbelow) = 0.
+       co2frac(iroot) = 0.
+       co2frac(ifruit) = .95
+       co2frac(icarbres) = 0.95
+
+       !! 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.
+    
+       !! 1.3 Read the flag that disables fire
+       !!Config  Key  = FIRE_DISABLE
+       !!Config  Desc = no fire allowed
+       !!Config  Def  = n
+       !!Config  Help = With this variable, you can allow or not
+       !!Config         the estimation of CO2 lost by fire
+       disable_fire=.FALSE.
+       CALL getin_p('FIRE_DISABLE', disable_fire)
+
+    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_above(:) = litter(:,imetabolic,j,iabove) + &
+            litter(:,istructural,j,iabove)
+
+
+       !! 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_above(:) .GT. min_stomate) )
+       !?? the calculation here is redundant? as the part before flam(j) is 1?
+       !?? see first comment.. litterpart to be removed ?
+          moistlimit(:) = &
+               ( litterpart(:,j,imetabolic)*litter(:,imetabolic,j,iabove) + &
+               litterpart(:,j,istructural)*litter(:,istructural,j,iabove)  ) / &
+               litter_above(:) * 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_above(:) ) / 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=0
+       
+       !! 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 ( 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) .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. 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) * fire_disturb(:) * co2frac(k) / dt
+
+             !! 4.2.2 Determine the residue
+             !        Residual is expressed in gC/m^2
+             residue(:) = biomass(:,j,k) * 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(:) = .3 / ( 1.3 ** ( 88.2 - 100.*co2frac(k) ) + 1. )
+             ELSE
+                bcfrac(:) = zero
+             ENDIF
+
+             !! 4.2.2.2 Add fraction of the residue to the black carbon "reservoir"
+             black_carbon(:) = &
+                  black_carbon(:) + bcfrac(:) * residue(:)
+
+             !! 4.2.2.3 The rest (largest part) of the residue becomes litter.
+             bm_to_litter(:,j,k) = bm_to_litter(:,j,k) + 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 k = 1, nparts
+
+          ! **2
+          IF ( .NOT. ( ( .NOT. tree(j) ) .AND. ( ( k.EQ.iroot ) .OR. ( k.EQ.icarbres) ) ) ) THEN
+
+             biomass(:,j,k) = ( un - fire_disturb(:) ) * biomass(:,j,k)
+
+          ENDIF
+
+       ENDDO
+
+       !! 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. 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.
+    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(:,imetabolic,j,iabove) * &
+            firefrac(:,j) / dt
+
+       !! 5.1.2 Decrease metabolic litter
+       litter(:,imetabolic,j,iabove) = litter(:,imetabolic,j,iabove) * &
+            ( un - firefrac(:,j) )
+
+    
+       !! 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(:) = 0.5 * lignin_struc(:,j,iabove)
+
+       !! 5.2.2 CO2 flux from litter burning 
+       !  Flux expressed in gC m^{-2}dtslow^{-1}
+       co2_fire(:,j) = co2_fire(:,j) + &
+            litter(:,istructural,j,iabove) * 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(:) = litter(:,istructural,j,iabove) * 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(:) = .3 / ( 1.3 ** ( 88.2 - 100.*(1.-struc_residual(:)) ) + 1. )
+
+       !! 5.2.5 Add this fraction of the residue to the black carbon "reservoir"
+       !        In gC m^{-2}
+       black_carbon(:) = &
+            black_carbon(:) + bcfrac(:) * residue(:)
+
+       !! 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.
+       litter(:,istructural,j,iabove) = &
+            litter(:,istructural,j,iabove) * ( un - firefrac(:,j) ) + &
+            residue(:) * ( un - bcfrac(:) )
+
+    ENDDO  !  loop over #PFT
+   
+   !! 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 (hist_id_stomate, 'FIREFRAC', itime, &
+         firefrac(:,:), npts*nvm, horipft_index)
+    CALL histwrite (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(:) / ( -.13*xm1(:)*xm1(:)*xm1(:) + .6*xm1(:)*xm1(:) + .8*xm1(:) + .45 ) )
+
+  END FUNCTION firefrac_func
+
+END MODULE lpj_fire
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_gap.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_gap.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_gap.f90	(revision 854)
@@ -0,0 +1,313 @@
+! =================================================================================================================================
+! 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 ioipsl
+  USE stomate_constants
+  USE constantes_veg
+  USE parallel
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC gap,gap_clear
+  
+  ! Variable declaration 
+
+  LOGICAL, SAVE             :: firstcall = .TRUE.                !! first call flag
+
+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), 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), 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), 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 
+    REAL(r_std)                                             :: ref_greff               !! Asymptotic maximum mortality rate 
+                                                                                       !! @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
+
+    ! Set asymptotic maximum mortality rate from Sitch 2003 (they use 0.01) (year^{-1})
+    ref_greff =  0.035
+
+    ! loop over #PFT
+    DO j = 2,nvm
+
+ !! 1. Tree mortality
+
+       IF ( 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) + &
+                  turnover_longterm(:,j,iroot) + turnover_longterm(:,j,ifruit) + & 
+                  turnover_longterm(:,j,isapabove) + turnover_longterm(:,j,isapbelow) ) ,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(:) = 0.0
+
+             ENDWHERE
+
+             !! 1.1.3 Calculate growth efficiency mortality rate
+             WHERE ( PFTpresent(:,j) )
+                
+                availability(:) = 0.1 / ( 1.+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) = 1.
+
+             ENDWHERE
+
+          ENDIF
+
+          !! 1.4 Update biomass and litter pools 
+          !    Update biomass and litter pool after dying and transfer recently died biomass to litter
+          DO k = 1, nparts
+
+             WHERE ( PFTpresent(:,j) )
+
+                dmortality(:) =  mortality(:,j) * biomass(:,j,k)
+                bm_to_litter(:,j,k) = bm_to_litter(:,j,k) + dmortality(:)
+                
+                biomass(:,j,k) = biomass(:,j,k) - dmortality(:)
+
+             ENDWHERE
+
+          ENDDO
+
+          !! 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. 10. ) )
+
+                mortality(:,j) = 1.
+
+             ENDWHERE
+
+             ! Update biomass and litter pools
+             DO k = 1, nparts
+
+                WHERE ( PFTpresent(:,j) )
+
+                   dmortality(:) =  mortality(:,j) * biomass(:,j,k)
+                   
+                   bm_to_litter(:,j,k) = bm_to_litter(:,j,k) + dmortality(:)
+                   
+                   biomass(:,j,k) = biomass(:,j,k) - dmortality(:)
+
+                ENDWHERE
+             ENDDO
+             
+          ENDIF
+          
+       ENDIF   !IF ( tree(j) )
+
+    ENDDO      !loop over pfts
+
+ !! 3. Write to history files
+
+    ! output in fraction of trees that dies/day.
+    mortality = mortality / dt
+
+    CALL histwrite (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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_kill.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_kill.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_kill.f90	(revision 854)
@@ -0,0 +1,259 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  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, veget_max, bm_to_litter)
+
+ !! 0. Variable and parameter description
+
+    !! 0.1 Input variable
+
+    INTEGER(i_std), INTENT(in)                                :: npts            !! Domain size (unitless)
+    CHARACTER*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 variable
+
+    !! 0.3 Modified variable
+
+    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           !! Fractional coverage on ground, taking into 
+                                                                                 !! account LAI (=grid-scale fpc) (unitless;0-1)
+    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,nparts), INTENT(inout)    :: biomass         !! Biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)    :: bm_to_litter    !! Conversion of biomass to litter 
+                                                                                 !! @tex $(gC.m^{-2} day^{-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)
+
+    !! 0.4 Local variable
+
+    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) .LE.zero .OR. & 
+                  biomass(:,j,iroot).LT.-min_stomate .OR. biomass(:,j,ileaf).LT.-min_stomate ).AND. & 
+                  ind(:,j).GT. zero)
+
+                was_killed(:) = .TRUE.
+
+             ENDWHERE
+
+             !! 1.2.2 Overwrite long-term NPP for grasses
+             IF(.NOT.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
+          
+             WHERE ( was_killed(:) )
+                bm_to_litter(:,j,ileaf) = bm_to_litter(:,j,ileaf) + biomass(:,j,ileaf)
+                bm_to_litter(:,j,isapabove) = bm_to_litter(:,j,isapabove) + biomass(:,j,isapabove)
+                bm_to_litter(:,j,isapbelow) = bm_to_litter(:,j,isapbelow) + biomass(:,j,isapbelow)
+                bm_to_litter(:,j,iheartabove) = bm_to_litter(:,j,iheartabove) + &
+                     biomass(:,j,iheartabove)
+                bm_to_litter(:,j,iheartbelow) = bm_to_litter(:,j,iheartbelow) + &
+                     biomass(:,j,iheartbelow)
+                bm_to_litter(:,j,iroot) = bm_to_litter(:,j,iroot) + biomass(:,j,iroot)
+                bm_to_litter(:,j,ifruit) = bm_to_litter(:,j,ifruit) + biomass(:,j,ifruit)
+                bm_to_litter(:,j,icarbres) = bm_to_litter(:,j,icarbres) + biomass(:,j,icarbres)
+
+                biomass(:,j,ileaf) = zero
+                biomass(:,j,isapabove) = zero
+                biomass(:,j,isapbelow) = zero
+                biomass(:,j,iheartabove) = zero
+                biomass(:,j,iheartbelow) = zero
+                biomass(:,j,iroot) = zero
+                biomass(:,j,ifruit) = zero
+                biomass(:,j,icarbres) = zero
+
+             ENDWHERE   ! was_killed
+
+            !! 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
+
+             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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_light.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_light.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_light.f90	(revision 854)
@@ -0,0 +1,658 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC light, light_clear
+
+  LOGICAL, SAVE                                            :: firstcall = .TRUE.             !! first call
+
+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), 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), 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
+
+    REAL(r_std), PARAMETER                                 :: grass_mercy = 0.01       !! Maximum total number of grass individuals
+                                                                                       !! in a CLOSED canopy (unitless) 
+    REAL(r_std), PARAMETER                                 :: tree_mercy = 0.01        !! Minimum fraction of trees that survive 
+                                                                                       !! even in a closed canopy (unitless;0-1)
+    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     
+
+    ! INTEGER(i_std)                                         :: num_grass              !! [DISPENSABLE] Number of grass PFTs present in the 
+                                                                                       !! grid box (unitless)       
+    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,*) '   > Maximum total number of grass individuals in'
+       WRITE(numout,*) '       a closed canopy: ', grass_mercy
+
+       WRITE(numout,*) '   > Minimum fraction of trees that survive even in'
+       WRITE(numout,*) '       a closed canopy: ', tree_mercy
+
+       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(:) = 1.
+       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 ( 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,:)), 0._r_std )
+             ELSE
+                deltafpc(:) = MAX( (fpc_nat(i,:)-veget_lastlight(i,:)), 0._r_std )
+             ENDIF
+
+             !! 2.4.1.2 Default survival
+             survive(:) = 1.0
+
+             
+             !! 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
+             ! num_grass = 0
+
+             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 ( 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)
+
+                      ! number of grass PFTs present in the grid box
+                      ! IF ( PFTpresent(i,j) ) THEN
+                      !    num_grass = num_grass + 1
+                      ! ENDIF
+
+                   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 ( 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 - tree_mercy ) )
+
+                         !!? 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
+
+                      survive(j) = un - reduct
+
+                   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.
+                      !
+
+                      ! survive(j) = ( grass_mercy / REAL( num_grass,r_std ) ) / ind(i,j)
+
+                      ! survive(j) = MIN( 1._r_std, survive(j) )
+
+                      IF(sumfpc_grass .GE. 1.0-MIN(fpc_crit,sumfpc_wood).AND. & 
+                           sumfpc_grass.GE.min_stomate) THEN
+
+                         fpc_dec=(sumfpc_grass-1.+MIN(fpc_crit,sumfpc_wood))*fpc_nat(i,j)/sumfpc_grass
+
+                         reduct=fpc_dec
+                      ELSE 
+                         reduct = zero
+                      ENDIF
+                      survive(j) = ( un -  reduct ) 
+                   ENDIF   ! tree or grass
+
+                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 ( 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 ( 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(:,:)=0.0
+
+       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( ( 1._r_std - exp( - ext_coeff(j) * lai_ind(:) ) ), min_cover )
+
+             WHERE(fpc_nat(:,j).GT.fpc_max(:,j))
+
+                light_death(:,j)=MIN(1.0,1.0-fpc_max(:,j)/fpc_nat(:,j)) 
+
+             ENDWHERE
+
+             !! 3.2 Update biomass and litter pools
+             DO k=1,nparts
+
+                bm_to_litter(:,j,k)=bm_to_litter(:,j,k)+light_death(:,j)*biomass(:,j,k)
+                biomass(:,j,k)=biomass(:,j,k)-light_death(:,j)*biomass(:,j,k)
+
+             ENDDO
+
+             !! 3.3 Update number of individuals
+             ind(:,j)=ind(:,j)-light_death(:,j)*ind(:,j)
+             ! if (j==10) print *,'ind10bis=',ind(:,j),light_death(:,j)*ind(:,j)
+
+          ENDIF
+       ENDDO
+
+       light_death(:,:)=light_death(:,:)/dt
+
+    ENDIF ! control%ok_dgvm
+
+   
+ !! 4. Write history files
+
+    CALL histwrite (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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_pftinout.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_pftinout.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/lpj_pftinout.f90	(revision 854)
@@ -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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC pftinout,pftinout_clear
+
+  LOGICAL, SAVE                       :: firstcall = .TRUE.                !! first call
+
+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, 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           !! fractional coverage on ground, taking into 
+                                                                                 !! account LAI (=grid-scale fpc) (unitless)
+    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), 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), PARAMETER                                    :: min_avail =0.01 !! minimum availability 
+    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(:) = 1.
+    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.tree(j) ) THEN
+          WHERE(fracnat(:).GT.min_stomate) 
+                sumfrac_wood(:) = sumfrac_wood(:) + cn_ind(:,j) * ind(:,j) / fracnat(:) & 
+                     * ( 1. - 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 ( 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,:) ) / 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 ( 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. 1.25 )
+
+             ! 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.0)
+                biomass(:,j,ileaf) = bm_sapl(j,ileaf) * ind(:,j) /veget_max(:,j)
+                biomass(:,j,isapabove) = bm_sapl(j,isapabove) * ind(:,j) /veget_max(:,j)
+                biomass(:,j,isapbelow) = bm_sapl(j,isapbelow) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iheartabove) = bm_sapl(j,iheartabove) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iheartbelow) = bm_sapl(j,iheartbelow) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,iroot) = bm_sapl(j,iroot) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,ifruit) = bm_sapl(j,ifruit) * ind(:,j)/veget_max(:,j)
+                biomass(:,j,icarbres) = bm_sapl(j,icarbres) * ind(:,j)/veget_max(:,j)
+             ELSEWHERE              
+                biomass(:,j,ileaf) = bm_sapl(j,ileaf) * ind(:,j)
+                biomass(:,j,isapabove) = bm_sapl(j,isapabove) * ind(:,j)
+                biomass(:,j,isapbelow) = bm_sapl(j,isapbelow) * ind(:,j)
+                biomass(:,j,iheartabove) = bm_sapl(j,iheartabove) * ind(:,j)
+                biomass(:,j,iheartbelow) = bm_sapl(j,iheartbelow) * ind(:,j)
+                biomass(:,j,iroot) = bm_sapl(j,iroot) * ind(:,j)
+                biomass(:,j,ifruit) = bm_sapl(j,ifruit) * ind(:,j)
+                biomass(:,j,icarbres) = bm_sapl(j,icarbres) * ind(:,j)
+             END WHERE
+            
+             co2_to_bm(:,j) = &
+                  co2_to_bm(:,j) / dt * &
+                  ( biomass(:,j,ileaf) + biomass(:,j,isapabove) + &
+                  biomass(:,j,isapbelow) + biomass(:,j,iheartabove) + &
+                  biomass(:,j,iheartbelow) + biomass(:,j,iroot) + &
+                  biomass(:,j,ifruit) + biomass(:,j,icarbres) )
+
+             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) = 10.
+
+             lm_lastyearmax(:,j) = bm_sapl(j,ileaf) * 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) = 0.05
+             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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate.f90	(revision 854)
@@ -0,0 +1,3391 @@
+! =================================================================================================================================
+! 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 ioipsl
+  USE defprec
+  USE grid
+  USE constantes
+  USE constantes_veg
+  USE constantes_co2
+  USE stomate_constants
+  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 parallel
+  ! USE Write_field_p
+  
+  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 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_cov_max        !! Maximal fractional coverage: maximum share of a pixel
+                                                                         !! taken by a PFT 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_cov_max_new    !! Updated maximal fractional coverage (unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ind                  !! Vegetation density, number of individuals per unit 
+                                                                         !! ground area @tex $(m^{-2})$ @endtex 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: age                  !! Age of PFT it normalized by biomass - can increase and
+                                                                         !! decrease - (years)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: adapted              !! Winter too cold for PFT to survive (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: regenerate           !! Winter sufficiently cold to produce viable seeds 
+                                                                         !! (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: everywhere           !! Is the PFT everywhere in the grid box or very localized 
+                                                                         !! (after its intoduction)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: fireindex            !! Probability of fire (unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: veget_lastlight      !! Vegetation fractions (on ground) after last light 
+                                                                         !! competition (unitless) 
+  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
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: PFTpresent           !! PFT exists (equivalent to veget > 0 for natural PFTs)
+  LOGICAL,ALLOCATABLE,SAVE,DIMENSION(:,:)        :: senescence           !! The PFT is senescent
+  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
+!--
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_daily         !! Daily plant available water -root profile weighted 
+                                                                         !! (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_week          !! "Weekly" plant available water -root profile weighted
+                                                                         !! (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: humrel_month         !! "Monthly" plant available water -root profile weighted
+                                                                         !! (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxhumrel_lastyear   !! Last year's max plant available water -root profile 
+                                                                         !! weighted (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxhumrel_thisyear   !! This year's max plant available water -root profile 
+                                                                         !! weighted (0-1, unitless) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: minhumrel_lastyear   !! Last year's min plant available water -root profile 
+                                                                         !! weighted (0-1, unitless)  
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: minhumrel_thisyear   !! This year's minimum plant available water -root profile
+                                                                         !! weighted (0-1, unitless)
+!---  
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_daily            !! Daily air temperature at 2 meter (K)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_week             !! Mean "weekly" (default 7 days) air temperature at 2 
+                                                                         !! meter (K)  
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_month            !! Mean "monthly" (default 20 days) air temperature at 2 
+                                                                         !! meter (K)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_longterm         !! Mean "Long term" (default 3 years) air temperature at 
+                                                                         !! 2 meter (K) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: t2m_min_daily        !! Daily minimum air temperature at 2 meter (K)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: tlong_ref            !! "Long term" (default 3 years) reference temperature at
+                                                                         !! 2 meter (K) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: tsurf_daily          !! Daily surface temperatures (K)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_daily         !! Daily precipitations sum @tex $(mm day^{-1})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_lastyear      !! Last year's annual precipitation sum 
+                                                                         !! @tex $??(mm year^{-1})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: precip_thisyear      !! This year's annual precipitation sum 
+                                                                         !! @tex $??(mm year^{-1})$ @endtex 
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: soilhum_daily        !! Daily soil humidity (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: soilhum_month        !! Soil humidity - integrated over a month (0-1, unitless) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: tsoil_daily          !! Daily soil temperatures (K)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: tsoil_month          !! Soil temperatures at each soil layer integrated over a
+                                                                         !! month (K) 
+!--- 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: litterhum_daily      !! Daily litter humidity (0-1, unitless)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_moist        !! Moisture control of heterotrophic respiration 
+                                                                         !! (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: control_temp         !! Temperature control of heterotrophic respiration at the
+                                                                         !! different soil levels (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: control_moist_daily  !! Moisture control of heterotrophic respiration daily 
+                                                                         !! (0-1, unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: control_temp_daily   !! Temperature control of heterotrophic respiration, above
+                                                                         !! and below daily (0-1, unitless)
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: gdd0_lastyear        !! Last year's annual Growing Degree Days,
+                                                                         !! threshold 0 deg C (K) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: gdd0_thisyear        !! This year's annual Growing Degree Days,
+                                                                         !! threshold 0 deg C (K)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_m5_dormance      !! Growing degree days for onset of growing season, 
+                                                                         !! threshold -5 deg C (K)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gdd_midwinter        !! Growing degree days for onset of growing season, 
+                                                                         !! since midwinter (K)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ncd_dormance         !! Number of chilling days since leaves were lost (days) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: ngd_minus5           !! Number of growing days, threshold -5 deg C (days)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: hum_min_dormance     !! Minimum moisture during dormance (0-1, unitless) 
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gpp_daily            !! Daily gross primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: gpp_week             !! Mean "weekly" (default 7 days) GPP  
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxgppweek_lastyear  !! Last year's maximum "weekly" GPP  
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: maxgppweek_thisyear  !! This year's maximum "weekly" GPP  
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex  
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_daily            !! Daily net primary productivity per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex 
+  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   
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: npp_equil            !! Equilibrium NPP written to forcesoil 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: npp_tot              !! Total NPP written to forcesoil 
+                                                                         !! @tex $(gC m^{-2} year^{-1})$ @endtex 
+!---
+  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
+  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
+  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
+  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
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_growth_d        !! Growth respiration per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: resp_hetero_d        !! Heterotrophic respiration per ground area 
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+  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 
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: turnover_time        !! Turnover time of grasses 
+                                                                         !! @tex $(dt_slow^{-1})$ @endtex 
+  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
+  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 
+  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
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: bm_to_litter         !! Background (not senescence-driven) mortality of biomass
+                                                                         !! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
+  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 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: dead_leaves          !! Metabolic and structural pools of dead leaves on ground
+                                                                         !! per PFT @tex $(gC m^{-2})$ @endtex 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: litter               !! Above and below ground metabolic and structural litter 
+                                                                         !! per ground area 
+                                                                         !! @tex $(gC m^{-2})$ @endtex 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: litterpart           !! Fraction of litter above the ground belonging to 
+                                                                         !! different litter pools (unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: firelitter           !! Total litter above the ground that could potentially 
+                                                                         !! burn @tex $(gC m^{-2})$ @endtex 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:,:):: soilcarbon_input     !! Quantity of carbon going into carbon pools from litter
+                                                                         !! decomposition per ground area  at Sechiba time step 
+                                                                         !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: soilcarbon_input_daily !! Daily quantity of carbon going into carbon pools from
+                                                                           !! litter decomposition per ground area 
+                                                                           !! @tex $(gC m^{-2} day^{-1})$ @endtex 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: carbon               !! Soil carbon pools per ground area: active, slow, or 
+                                                                         !! passive, @tex $(gC m^{-2})$ @endtex 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: lignin_struc         !! Ratio Lignine/Carbon in structural litter for above and
+                                                                         !! below ground compartments (unitless)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: black_carbon         !! Black carbon on the ground 
+                                                                         !! @tex $(gC m^{-2})$ @endtex   
+!---
+  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  
+  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  
+  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)?? 
+  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)??
+!---
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: leaf_age             !! Age of different leaf classes (days)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: leaf_frac            !! PFT fraction of leaf mass in leaf age class (0-1, 
+                                                                         !! unitless) 
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: when_growthinit      !! Days since beginning of growing season (days)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: herbivores           !! Time constant of probability of a leaf to be eaten by a
+                                                                         !! herbivore (days)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: RIP_time             !! How much time ago was the PFT eliminated for the last 
+                                                                         !! time (year)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: time_lowgpp          !! Duration of dormancy (days)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)    :: time_hum_min         !! Time elapsed since strongest moisture limitation (days) 
+!---
+  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(:,:)         :: 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 
+  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 
+  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?
+  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? 
+  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)
+  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)
+  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)  
+  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)
+  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  
+  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
+  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
+  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
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: carb_mass_total      !! Total on-site and off-site C pool 
+                                                                         !! @tex $(??gC m^{-2})$ @endtex                        
+!---
+  REAL(r_std),SAVE                               :: dt_days=zero         !! Time step of STOMATE (days) 
+  REAL(r_std),SAVE                               :: day_counter=zero     !! Time step each day sechiba (dtradia)   
+  INTEGER(i_std),SAVE                            :: date=0               !! Date (days) 
+  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    
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:)   :: isf                  !! Index for number of time steps that can be stored in 
+                                                                         !! memory (unitless), dimension (#nsfm)
+  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?
+  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
+!---
+  LOGICAL, SAVE                                  :: do_slow=.FALSE.      !! Flag that determines whether stomate_accu calculates
+                                                                         !! the sum(do_slow=.FALSE.) or the mean 
+                                                                         !! (do_slow=.TRUE.)
+  LOGICAL, SAVE                                  :: EndOfYear=.FALSE.    !! Update annual variables? This variable must be 
+                                                                         !! .TRUE. once a year
+  LOGICAL, SAVE                                  :: lcchange=.FALSE.     !! Land cover change flag 
+  LOGICAL, SAVE                                  :: EndOfMonth=.FALSE.   !! Update monthly variables? This variable must be 
+                                                                         !!.TRUE. once a month 
+  LOGICAL, SAVE                                  :: l_first_stomate = .TRUE.!! Is this the first call of stomate?
+  LOGICAL, SAVE                                  :: cumul_forcing=.FALSE.!! flag for cumul of forcing if teststomate
+  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
+!---   
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: harvest_above_monthly   !! [??CHECK] post-processing - should be removed?
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:)      :: cflux_prod_monthly      !! [??CHECK] post-processing - should be removed?
+!---
+ 
+PUBLIC clay_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, lcchange
+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.
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): deadleaf_cover, assim_param, lai, height, veget, 
+!! veget_max, veget_max_new, totfrac_nobio_new, qsintmax, resp_maint, 
+!! resp_hetero,resp_growth, co2_flux, fco2_lu.
+!!
+!! REFERENCES	: None
+!!
+!! 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, height, veget, veget_max, qsintmax, &
+       &  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)
+    
+    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,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 
+
+    !! 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  
+
+    !! 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(inout)       :: 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),INTENT(inout)       :: qsintmax       !! Maximum water storage on vegetation from 
+                                                                              !! interception (mm) 
+    
+    !! 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         !! 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)           :: 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,nlevs)         :: control_moist_inst       !! Moisture control of heterotrophic respiration 
+                                                                              !! (0-1, unitless) 
+    REAL(r_std),DIMENSION(kjpindex,nlevs)         :: control_temp_inst        !! Temperature control of heterotrophic 
+                                                                              !! respiration, above and below (0-1, unitless) 
+    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),SAVE                              :: dt_forcesoil             !! Time step of soil forcing file (days)
+                                                                              !!?? 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) 
+    INTEGER(i_std),SAVE                           :: nbyear                   !! Number of years saved for forcesoil - read from 
+                                                                              !! run definition (unitless) 
+    INTEGER(i_std),SAVE                           :: iatt                     !! Time step of forcing of soil processes (iatt = 1 
+                                                                              !! to ::nparan*::nbyear) 
+    INTEGER(i_std),SAVE                           :: iatt_old=1               !! Previous ::iatt
+    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) 
+    INTEGER(i_std),SAVE                           :: nsft                     !! Number of time steps in a year (unitless)
+ 
+   INTEGER(i_std),SAVE                            :: iisf                     !! Current pointer for teststomate (unitless)
+    REAL(r_std), DIMENSION(kjpindex)              :: vartmp                   !! Temporary variable
+    CHARACTER(LEN=100), SAVE                      :: forcing_name             !! Name of forcing file 1
+    CHARACTER(LEN=100), SAVE                      :: Cforcing_name            !! Name of forcing file 2
+    INTEGER(i_std),SAVE                           :: Cforcing_id              !! File identifer of file 2
+    
+    INTEGER(i_std),PARAMETER                      :: ndm = 10                 !! 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
+ 
+    REAL(r_std),DIMENSION(nbp_glo)                :: clay_g                   !! Clay fraction of soil (0-1, unitless), parallel 
+                                                                              !! computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:,:)    :: soilcarbon_input_g       !! Quantity of carbon going into carbon pools from 
+                                                                              !! litter decomposition  
+                                                                              !! @tex $(gC m^{-2} dtradia^{-1})$ @endtex, parallel 
+                                                                              !! computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_moist_g          !! Moisture control of heterotrophic respiration 
+                                                                              !! (0-1, unitless), parallel computing 
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:,:)      :: control_temp_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)                                   :: 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 
+!_ ================================================================================================================================
+    
+  !! 1. Initialize variables
+
+    !! 1.1 Store current time step in a common variable
+    itime = kjit
+    
+    !! 1.2 Copy the depth of the different soil layers from diaglev specified in slow_proc
+    z_soil(0) = zero
+    z_soil(1:nbdl) = diaglev(1:nbdl)
+															
+    !! 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 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.
+       CALL stomate_constants_init ()
+       
+       !! 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, 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_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_lowgpp, &
+            &         time_hum_min, hum_min_dormance, &
+            &         litterpart, litter, dead_leaves, &
+            &         carbon, black_carbon, lignin_struc,turnover_time,&
+            &         prod10,prod100,flux10, flux100, &
+            &         convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total)
+
+       !! 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  Def  = NONE
+          !Config  Help = Name that will be given
+          !Config         to STOMATE's offline forcing file
+          !Config         Compatible with Nicolas Viovy's driver
+          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 (MB)
+             !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.
+             max_totsize = 50
+             CALL getin_p('STOMATE_FORCING_MEMSIZE', max_totsize)      
+             max_totsize = max_totsize*1000000
+
+             totsize_1step = &
+                  &      SIZE(clay)*KIND(clay) &
+                  &           +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',nsft,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,'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  Def  = NONE
+          !Config  Help = Name that will be given to STOMATE's carbon
+          !Config         offline forcing file
+          !Config         Compatible with Nicolas Viovy's driver
+          Cforcing_name = stomate_Cforcing_name
+          CALL getin_p('STOMATE_CFORCING_NAME',Cforcing_name)
+
+          IF ( TRIM(Cforcing_name) /= 'NONE' ) THEN
+  
+             ! For root processor only (parallel computing)
+             IF (is_root_prc) CALL SYSTEM ('rm -f '//TRIM(Cforcing_name))
+             
+             ! Time step of forcesoil
+             !Config  Key  = FORCESOIL_STEP_PER_YEAR
+             !Config  Desc = Number of time steps per year for carbon spinup.
+             !Config  Def  = 365
+             !Config  Help = Number of time steps per year for carbon spinup.
+             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 internal parameter cumul_Cforcing is TRUE in stomate.f90
+             !config         Then this parameter is forced to one.
+             !Config  Def  = 1
+             !Config  Help = Number of years saved for carbon spinup.
+             nbyear=1
+             CALL getin_p('FORCESOIL_NB_YEAR', nbyear)
+             
+             ! Set ::nbyear to 1. if ::cumul_Cforcing=.TRUE.
+             IF ( cumul_Cforcing ) THEN
+                CALL ipslerr (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(kjpindex,nlevs,nparan*nbyear))
+             ALLOCATE(npp_equil(kjpindex,nparan*nbyear))
+             ALLOCATE(npp_tot(kjpindex))
+             ALLOCATE(control_temp(kjpindex,nlevs,nparan*nbyear))
+             ALLOCATE(soilcarbon_input(kjpindex,ncarb,nvm,nparan*nbyear)) 
+             
+             ! Initialize variables, set to zero
+             control_moist(:,:,:) = zero
+             npp_equil(:,:) = zero
+             npp_tot(:) = zero
+             control_temp(:,:,:) = zero
+             soilcarbon_input(:,:,:,:) = 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, veget_cov_max, leaf_age, leaf_frac, &
+               &          tlong_ref, t2m_month, dead_leaves, &
+               &          veget, lai, qsintmax, 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, 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_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_lowgpp, &
+            &          time_hum_min, hum_min_dormance, &
+            &          litterpart, litter, dead_leaves, &
+            &          carbon, black_carbon, lignin_struc,turnover_time,&
+            &          prod10,prod100,flux10, flux100, &
+            &          convflux, cflux_prod10, cflux_prod100, bm_to_litter,carb_mass_total)
+       
+       !! 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)
+                control_moist(:,:,iatt) = &
+                     & control_moist(:,:,iatt)/REAL(nforce(iatt),r_std)
+                control_temp(:,:,iatt) = &
+                     & control_temp(:,:,iatt)/REAL(nforce(iatt),r_std)
+                npp_equil(:,iatt) = &
+                     & npp_equil(:,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
+                control_moist(:,:,iatt) = zero
+                control_temp(:,:,iatt) = zero
+                npp_equil(:,iatt) = zero
+             ENDIF
+          ENDDO
+
+          ! Allocate memory for parallel computing
+          IF (is_root_prc) THEN
+             ALLOCATE(soilcarbon_input_g(nbp_glo,ncarb,nvm,nparan*nbyear))
+             ALLOCATE(control_moist_g(nbp_glo,nlevs,nparan*nbyear))
+             ALLOCATE(control_temp_g(nbp_glo,nlevs,nparan*nbyear))
+             ALLOCATE(npp_equil_g(nbp_glo,nparan*nbyear))
+          ENDIF
+          
+          ! Gather distributed variables
+          CALL gather(clay,clay_g)
+          CALL gather(soilcarbon_input,soilcarbon_input_g)
+          CALL gather(control_moist,control_moist_g)
+          CALL gather(control_temp,control_temp_g)
+          CALL gather(npp_equil,npp_equil_g)
+          
+          !! 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
+
+             ! Create new netCDF dataset
+             ier = NF90_CREATE (TRIM(Cforcing_name),NF90_WRITE,Cforcing_id)
+
+             ! 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',nparan*nbyear,d_id(5))
+             
+             ! 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,'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,'soilcarbon_input',r_typ, &
+                  &                        (/ d_id(1),d_id(2),d_id(3),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'control_moist',r_typ, &
+                  &                        (/ d_id(1),d_id(4),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'control_temp',r_typ, &
+                  &                        (/ d_id(1),d_id(4),d_id(5) /),vid)
+             ier = NF90_DEF_VAR (Cforcing_id,'npp_equil',r_typ, &
+                  &                        (/ d_id(1),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,'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,'soilcarbon_input',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, soilcarbon_input_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'control_moist',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, control_moist_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'control_temp',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, control_temp_g )
+             ier = NF90_INQ_VARID (Cforcing_id,'npp_equil',vid)
+             ier = NF90_PUT_VAR (Cforcing_id,vid, npp_equil_g )
+             
+             ! Close netCDF
+             ier = NF90_CLOSE (Cforcing_id)
+             Cforcing_id = -1
+          ENDIF
+
+          ! Clear memory
+          IF (is_root_prc) THEN
+             DEALLOCATE(soilcarbon_input_g)
+             DEALLOCATE(control_moist_g)
+             DEALLOCATE(control_temp_g)
+             DEALLOCATE(npp_equil_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.
+    ! Note: there is no vertical discretisation in the soil for litter decay.
+    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, &
+         litterpart, litter, dead_leaves, lignin_struc, &
+         deadleaf_cover, resp_hetero_litter, &
+         soilcarbon_input_inst, control_temp_inst, control_moist_inst)
+    
+    ! 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_inst, control_moist_inst, &
+         carbon, resp_hetero_soil)
+    
+    ! 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
+    
+    !! 4.6 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, nlevs, dt_slow, dtradia, &
+     & do_slow, control_moist_inst, control_moist_daily)
+    CALL stomate_accu (kjpindex, nlevs, dt_slow, dtradia, &
+     & do_slow, control_temp_inst, control_temp_daily)
+    DO i=1,ncarb
+       CALL stomate_accu (kjpindex, nvm, dt_slow, dtradia, &
+            & do_slow, soilcarbon_input_inst(:,i,:), soilcarbon_input_daily(:,i,:))
+    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)*sla(j)
+          ENDDO
+       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) 
+       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, &
+            &           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_lowgpp, time_hum_min, hum_min_dormance, 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_midwinter, ncd_dormance, ngd_minus5, &
+               &             turnover_longterm, gpp_daily, time_lowgpp, &
+               &             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, &
+               &             dead_leaves, carbon, black_carbon, lignin_struc, &
+               &             veget_cov_max, veget_cov, npp_longterm, lm_lastyearmax, &
+               &             veget_lastlight, everywhere, need_adjacent, RIP_time, &
+               &             lai, rprof,npp_daily, turnover_daily, turnover_time,&
+               &             control_moist_inst, control_temp_inst, 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)
+
+          !! 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(:,:) = zero 
+          veget_max(:,:) = zero 
+          DO j = 1, nvm
+             veget(:,j) = veget(:,j) + &
+                  & veget_cov(:,j) * ( 1.-totfrac_nobio(:) )
+             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)
+             IF (iatt == 0) iatt = iatt_old + 1
+             IF ((iatt<iatt_old) .and. (.not. cumul_Cforcing)) THEN
+                nforce(:)=0
+                soilcarbon_input(:,:,:,:) = zero
+                control_moist(:,:,:) = zero
+                control_temp(:,:,:) = zero
+                npp_equil(:,:) = zero
+             ENDIF
+             iatt_old = iatt
+             ! Update forcing
+             nforce(iatt) = nforce(iatt)+1
+             soilcarbon_input(:,:,:,iatt) = soilcarbon_input(:,:,:,iatt) + &
+              & soilcarbon_input_daily(:,:,:)
+             control_moist(:,:,iatt) = control_moist(:,:,iatt) + control_moist_daily(:,:)
+             control_temp(:,:,iatt) = control_temp(:,:,iatt) + control_temp_daily(:,:)
+             npp_equil(:,iatt) = npp_equil(:,iatt) + npp_tot(:)
+          ENDIF ! ldcarbon_write
+          
+          !! 5.7 Update leaf interception
+          DO j=2,nvm
+             qsintmax(:,j) = qsintcst * veget(:,j) * lai(:,j)
+          ENDDO
+
+       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.)
+             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(:)
+             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 (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 (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 (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
+       
+       !! 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
+       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. 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  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.
+    
+    ! By default, ::bavard is set to 1 in stomate_constants
+    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  Def  = 1
+       !Config  Help = This is the index of the grid point which
+       !               will be used for online diagnostics.
+       
+       ! 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)
+    ALLOCATE(veget_cov_max_new(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(ind(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(adapted(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(regenerate(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(humrel_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(litterhum_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(t2m_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(t2m_min_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(tsurf_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(tsoil_daily(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(soilhum_daily(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(precip_daily(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(gpp_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(npp_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(turnover_daily(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(turnover_littercalc(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(humrel_month(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(humrel_week(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(t2m_longterm(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(tlong_ref(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(t2m_month(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(t2m_week(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(tsoil_month(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(soilhum_month(kjpindex,nbdl),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(fireindex(kjpindex,nvm),stat=ier) 
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(firelitter(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(maxhumrel_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(maxhumrel_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(minhumrel_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(minhumrel_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(maxgppweek_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(maxgppweek_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(gdd0_lastyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(gdd0_thisyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(precip_lastyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(precip_thisyear(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(gdd_m5_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(gdd_midwinter(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(ncd_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(ngd_minus5(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(PFTpresent(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(npp_longterm(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(lm_lastyearmax(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(lm_thisyearmax(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(maxfpc_lastyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(maxfpc_thisyear(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(turnover_longterm(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(gpp_week(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(biomass(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(senescence(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(when_growthinit(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(age(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(resp_hetero_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(resp_hetero_radia(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(resp_maint_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(resp_growth_d(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(co2_fire(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(co2_to_bm_dgvm(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(veget_lastlight(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(everywhere(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(need_adjacent(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(leaf_age(kjpindex,nvm,nleafages),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(leaf_frac(kjpindex,nvm,nleafages),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(RIP_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(time_lowgpp(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(time_hum_min(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(hum_min_dormance(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(litterpart(kjpindex,nvm,nlitt),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(litter(kjpindex,nlitt,nvm,nlevs),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(dead_leaves(kjpindex,nvm,nlitt),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(carbon(kjpindex,ncarb,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(black_carbon(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(lignin_struc(kjpindex,nvm,nlevs),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(turnover_time(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(co2_flux_daily(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(co2_flux_monthly(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE (cflux_prod_monthly(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (harvest_above_monthly(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE(bm_to_litter(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(bm_to_littercalc(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(herbivores(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(hori_index(kjpindex),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(horipft_index(kjpindex*nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(resp_maint_part_radia(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(resp_maint_radia(kjpindex,nvm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(resp_maint_part(kjpindex,nvm,nparts),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    resp_maint_part(:,:,:)=zero
+    ALLOCATE (horip10_index(kjpindex*10), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (horip100_index(kjpindex*100), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (horip11_index(kjpindex*11), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (horip101_index(kjpindex*101), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (prod10(kjpindex,0:10), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (prod100(kjpindex,0:100), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (flux10(kjpindex,10), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (flux100(kjpindex,100), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (convflux(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (cflux_prod10(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (cflux_prod100(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (harvest_above(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (carb_mass_total(kjpindex), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (soilcarbon_input_daily(kjpindex,ncarb,nvm), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (control_temp_daily(kjpindex,nlevs), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (control_moist_daily(kjpindex,nlevs), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+    ALLOCATE (fpc_max(kjpindex,nvm), stat=ier)
+    l_error = l_error .OR. (ier.NE.0)
+
+    IF (l_error) THEN
+       STOP 'stomate_init: error in memory allocation'
+    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
+       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
+       ENDDO
+    ENDDO
+
+    DO j = 1, 100
+       DO ji = 1, kjpindex
+          horip100_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij
+       ENDDO
+    ENDDO
+
+    DO j = 1, 11
+       DO ji = 1, kjpindex
+          horip11_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij
+       ENDDO
+    ENDDO
+
+    DO j = 1, 101
+       DO ji = 1, kjpindex
+          horip101_index((j-1)*kjpindex+ji) = index(ji)+(j-1)*kjpij
+       ENDDO
+    ENDDO
+    
+  !! 6. Read and communicate settings of flags
+
+    !Config  Key  = HERBIVORES
+    !Config  Desc = herbivores allowed?
+    !Config  Def  = n
+    !Config  Help = This variable determines
+    !Config         if herbivores are activated
+    ok_herbivores = .FALSE.
+    CALL getin_p('HERBIVORES', ok_herbivores)
+    WRITE(numout,*) 'herbivores activated (::ok_herbivores): ',ok_herbivores
+    
+    !Config  Key  = TREAT_EXPANSION
+    !Config  Desc = treat expansion of PFTs across a grid cell?
+    !Config  Def  = n
+    !Config  Help = This variable determines whether the model
+    !Config         treats expansion of PFTs across a
+    !Config         grid cell.
+    treat_expansion = .FALSE.
+    CALL getin_p('TREAT_EXPANSION', treat_expansion)
+    WRITE(numout,*) &
+     &  'expansion across a grid cell is treated (::treat_expansion): ',&
+     & treat_expansion
+
+    !Config Key  = LPJ_GAP_CONST_MORT
+    !Config Desc = prescribe mortality if not using DGVM?
+    !Config Def  = y
+    !Config Help = set to TRUE if constant mortality is to be activated
+    !              ignored if DGVM=true!
+    lpj_gap_const_mort=.TRUE.
+    CALL getin('LPJ_GAP_CONST_MORT', lpj_gap_const_mort)
+    WRITE(numout,*) 'Your setting is ignored if DGVM=true'
+    WRITE(numout,*) 'LPJ GAP: constant mortality (::lpj_gap_const_mort): ',&
+     & lpj_gap_const_mort
+
+    !Config  Key  = HARVEST_AGRI
+    !Config  Desc = Harvest model for agricol PFTs.
+    !Config  Def  = y
+    !Config  Help = Compute harvest of above ground biomass for agriculture.
+    !Config         Change daily turnover.
+    harvest_agri = .TRUE.
+    CALL getin_p('HARVEST_AGRI', harvest_agri)
+    WRITE(numout,*) &
+     & 'Harvest above ground biomass of agricultural PFTs (::harvest_agri): ',& 
+     & harvest_agri
+
+  !! 7. 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_daily(:,:) = zero
+    control_temp_daily(:,:) = zero
+    soilcarbon_input_daily(:,:,:) = 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(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_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_lowgpp)) DEALLOCATE(time_lowgpp)
+    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)) DEALLOCATE(litter)
+    IF (ALLOCATED(dead_leaves)) DEALLOCATE(dead_leaves)
+    IF (ALLOCATED(carbon)) DEALLOCATE(carbon)
+    IF (ALLOCATED(black_carbon)) DEALLOCATE(black_carbon)
+    IF (ALLOCATED(lignin_struc)) DEALLOCATE(lignin_struc)
+    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(clay_fm)) DEALLOCATE(clay_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 (is_root_prc) THEN
+       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)
+    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)) DEALLOCATE(control_moist)
+    IF (ALLOCATED(control_temp)) DEALLOCATE(control_temp)
+    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_daily)) DEALLOCATE (control_temp_daily)
+    IF ( ALLOCATED (control_moist_daily)) DEALLOCATE (control_moist_daily)
+
+    IF ( ALLOCATED (fpc_max)) DEALLOCATE (fpc_max)
+
+ !! 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 (:: qsintmax), 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, veget_cov_max, leaf_age, leaf_frac, &
+       &   tlong_ref, t2m_month, dead_leaves, &
+       &   veget, lai, qsintmax, 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       !! Fractional coverage: actually share of the pixel 
+                                                                             !! covered by a PFT (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 
+                                                                             !! (unitless; 1) 
+    
+    !! 0.3 Output variables
+
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out)       :: qsintmax        !! Maximum water storage on vegetation from 
+                                                                             !! 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 (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)     
+       
+  !! 3. qsintmax
+
+       qsintmax(:,ibare_sechiba) = zero
+       DO j=2,nvm
+          ! Transforms lai into size of interception reservoir (mm)
+          ! ::qsintcst defined in constantes_soil.f90
+          qsintmax(:,j) = qsintcst*veget(:,j)*lai(:,j)
+       ENDDO
+
+    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 ::dt_tot
+    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)
+    ALLOCATE(humrel_daily_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(litterhum_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(t2m_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(t2m_min_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(tsurf_daily_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(tsoil_daily_fm(kjpindex,nbdl,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(soilhum_daily_fm(kjpindex,nbdl,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(precip_fm(kjpindex,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(gpp_daily_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(veget_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(veget_max_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(lai_fm(kjpindex,nvm,nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(isf(nsfm),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    ALLOCATE(nf_written(nsft),stat=ier)
+    l_error = l_error .OR. (ier /= 0)
+    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'
+       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)
+       ALLOCATE(humrel_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       ALLOCATE(litterhum_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       ALLOCATE(t2m_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       ALLOCATE(t2m_min_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       ALLOCATE(tsurf_daily_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       ALLOCATE(tsoil_daily_fm_g(nbp_glo,nbdl,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       ALLOCATE(soilhum_daily_fm_g(nbp_glo,nbdl,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       ALLOCATE(precip_fm_g(nbp_glo,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       ALLOCATE(gpp_daily_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       ALLOCATE(veget_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       ALLOCATE(veget_max_fm_g(nbp_glo,nvm,nsfm),stat=ier)
+       l_error = l_error .OR. (ier /= 0)
+       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'
+          STOP 'init_forcing'
+       ENDIF
+    ELSE
+       ! Allocate memory for co-processors
+       ALLOCATE(clay_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
+    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 = 10    !! 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(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 = 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 = 10          !! 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
+          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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.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.NE.0)
+             IF (a_er) THEN
+                CALL ipslerr (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(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)*sla(j)
+    ENDDO
+    
+  END SUBROUTINE setlai
+
+END MODULE stomate
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_alloc.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_alloc.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_alloc.f90	(revision 854)
@@ -0,0 +1,713 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  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) 
+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), 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)
+    INTEGER(i_std)                                             :: i,j,l,m		!! Indices (unitless)
+    LOGICAL, PARAMETER                                 :: ok_minres = .TRUE.            !! [DISPENSABLE] Do we try to reach a 
+                                                                                        !! minimum reservoir even if we are 
+                                                                                        !! severely stressed? (true/false). 
+                                                                                        !! Duplicates bavard - no other function
+                                                                                        !! in this routine
+    REAL(r_std), PARAMETER                             :: tau_leafinit = 10.		!! Time required to develop a minimal LAI
+                                                                                        !! using the carbohydrate reserve (days)
+    REAL(r_std), PARAMETER                             :: reserve_time_tree = 30.	!! Maximum number of days during which 
+                                                                                        !! carbohydrate reserve may be used for 
+                                                                                        !! trees (days)
+    REAL(r_std), PARAMETER                             :: reserve_time_grass = 20.	!! Maximum number of days during which 
+                                                                                        !! carbohydrate reserve may be used for 
+                                                                                        !! grasses (days)
+    REAL(r_std), PARAMETER                             :: R0 = 0.3			!! Default root allocation (0-1, unitless)
+    REAL(r_std), PARAMETER                             :: S0 = 0.3			!! Default sapwood allocation
+                                                                                        !! (0-1, unitless)
+    REAL(r_std), PARAMETER                             :: L0 = 1. - R0 - S0		!! Default leaf allocation (0-1, unitless)
+    REAL(r_std), PARAMETER                             :: f_fruit = 0.1			!! Default fruit allocation (0-1, unitless)
+    REAL(r_std), PARAMETER                             :: alloc_sap_above_tree = 0.5	!! Fraction of sapwood allocation above 
+                                                                                        !! ground for trees (0-1, unitless)
+    REAL(r_std), PARAMETER                             :: alloc_sap_above_grass = 1.0	!! Fraction of sapwood allocation above 
+                                                                                        !! ground for trees (0-1, unitless)
+    REAL(r_std), PARAMETER                             :: min_LtoLSR = 0.2		!! Prescribed lower bounds for leaf 
+                                                                                        !! allocation (0-1, unitless)
+    REAL(r_std), PARAMETER                             :: max_LtoLSR = 0.5              !! Prescribed upper bounds for leaf 
+                                                                                        !! allocation (0-1, unitless)
+    REAL(r_std), PARAMETER                             :: z_nitrogen = 0.2		!! Curvature of the root profile (m)
+!_ ================================================================================================================================
+
+
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering alloc'
+
+!! 1. Initialize
+
+    !! 1.1 First call only
+    IF ( firstcall ) THEN
+       
+       !! 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) = 0.
+       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,*) '       trees (::alloc_sap_above_tree):', alloc_sap_above_tree
+       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(:,:,:) = 0.0
+    f_alloc(:,:,icarbres) = 1.0
+
+ 
+    !! 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(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / z_nitrogen ) )
+
+    ! Integrate over # soil layers
+    t_nitrogen(:) = 0.
+
+    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(:) = 0.0
+
+    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(:) = 0.0
+    lai_nat(:) = 0.0
+
+    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) = 0.0
+       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(:) * 0.5
+
+
+ !! 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)
+
+    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 ( 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) .GT. 0.0 ) .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), &
+               2._r_std * 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) = biomass(:,j,ileaf) + transloc_leaf(:)
+          biomass(:,j,iroot) = biomass(:,j,iroot) + ( 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) = biomass(:,j,icarbres) - use_reserve(:)
+
+       ELSEWHERE
+
+          transloc_leaf(:) = 0.0
+
+       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) .GT. min_stomate )
+          
+          leaf_frac(:,j,1) = leaf_mass_young(:) / biomass(:,j,ileaf)
+
+       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) .GT. min_stomate )
+
+             leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf)
+
+          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(:)=0
+       LtoLSR(:)=0
+       StoLSR(:)=0
+
+           ! 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 ( tree(j) ) THEN
+
+          alloc_sap_above (:) = alloc_min(j)+(alloc_max(j)-alloc_min(j))*(1.-EXP(-age(:,j)/demi_alloc(j)))
+          !IF (j .EQ. 3) WRITE(*,*) '%allocated above = 'alloc_sap_above(dimensionless; 1),'age = ',age(1,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) .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) < 10 )
+             
+             limit_L(:) = MAX( 0.1_r_std, EXP( -0.5_r_std * 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( 1._r_std, 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( 0.5_r_std, MIN( 1._r_std, 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-25.)/10.)
+          limit_N_temp(:) = MAX( 0.1_r_std, MIN( 1._r_std, limit_N_temp(:) ) )
+
+          ! Combine water and temperature factors to get total nitrogen stress
+          limit_N(:) = MAX( 0.1_r_std, MIN( 1._r_std, 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 * 3._r_std * limit_L(:) / ( limit_L(:) + 2._r_std * 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(:) = 1. - 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(:) = 1. - 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) .GT. min_stomate) .AND. (lai(:,j) .GT. lai_max(j)) )
+
+          StoLSR(:) = StoLSR(:) + LtoLSR(:)
+          LtoLSR(:) = 0.0
+
+       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) .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) = 1.0
+
+             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)*sla(j) ) .LT. 2*lai_max(j) ) THEN
+                   carb_rescale(i) = 1. / ( 1. + ecureuil(j) * ( LtoLSR(i) + RtoLSR(i) ) )
+                ELSE
+                   carb_rescale(i) = 1.
+                ENDIF
+
+                f_alloc(i,j,ileaf) = LtoLSR(i) * ( 1.-f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,isapabove) = StoLSR(i) * alloc_sap_above(i) * &
+                     ( 1. - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,isapbelow) = StoLSR(i) * ( 1. - alloc_sap_above(i) ) * &
+                     ( 1. - f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,iroot) = RtoLSR(i) * ( 1.-f_alloc(i,j,ifruit) ) * carb_rescale(i)
+                f_alloc(i,j,icarbres) = ( 1. - carb_rescale(i) ) * ( 1.-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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_assimtemp.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_assimtemp.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_assimtemp.f90	(revision 854)
@@ -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 stomate_constants
+  USE constantes_veg
+
+  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) = t_photo%t_min_c(j) + t_photo%t_min_b(j)*tl(:) + t_photo%t_min_a(j)*tl(:)*tl(:) + ZeroCelsius
+       t_photo_opt(:,j) = t_photo%t_opt_c(j) + t_photo%t_opt_b(j)*tl(:) + t_photo%t_opt_a(j)*tl(:)*tl(:) + ZeroCelsius
+       t_photo_max(:,j) = t_photo%t_max_c(j) + t_photo%t_max_b(j)*tl(:) + t_photo%t_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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_constants.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_constants.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_constants.f90	(revision 854)
@@ -0,0 +1,824 @@
+! =================================================================================================================================
+! MODULE       : stomate_constants
+!
+! 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 lists and initializes the parameters used by STOMATE.
+!!
+!!\n DESCRIPTION: Some parameters are derived from the pipe model (Reineke). 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S)	:
+!! - Reineke LH (1933) Perfecting a stand density index for even-aged
+!! forests. J Agric Res 46:627â638
+!! - Sitch, S., et al. (2003), Evaluation of ecosystem dynamics, plant geography
+!! and terrestrial carbon cycling in the LPJ dynamic vegetation model,
+!! Global Change Biol., 9, 161 â 185.
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_constants
+!---------------------------------------------------------------------
+  USE defprec
+  USE constantes_veg
+  USE ioipsl  
+  USE parallel
+
+
+  INTEGER(i_std),PARAMETER :: ibare_sechiba = 1                        !! index for bare soil in Sechiba (unitless)
+!-
+  INTEGER(i_std),SAVE :: bavard=1                                      !! values: 0 = no, 4 = full online diagnostics 
+                                                                       !! (0-4, unitless)
+
+  LOGICAL,SAVE :: write_carbonforce                                    !! [DISPENSABLE] write forcing file for carbon spinup? 
+                                                                       !! (true/false)
+
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: hori_index           !! Horizontal indices (unitless)
+  INTEGER(i_std),ALLOCATABLE,SAVE,DIMENSION(:) :: horipft_index        !! Horizonatal + PFT indices (unitless)
+!-
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip10_index    !! Land cover change
+                                                                      !! Horizontal + P10 indices (unitless)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip100_index   !! Land cover change
+                                                                      !! Horizontal + P100 indices (unitless)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip11_index    !! Land cover change
+                                                                      !! Horizontal + P11 indices (unitless)
+
+  INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:) :: horip101_index   !! Land cover change
+                                                                      !! Horizontal + P101 indices (unitless)
+!-
+  INTEGER(i_std),SAVE :: itime                        !! time step (s)
+  INTEGER(i_std),SAVE :: hist_id_stomate              !! STOMATE history file ID for standard output (unitless)
+  INTEGER(i_std),SAVE :: hist_id_stomate_IPCC         !! STOMATE history file ID for IPCC output (unitless)
+  INTEGER(i_std),SAVE :: rest_id_stomate              !! STOMATE restart file ID (unitless)
+!-
+  REAL(r_std),PARAMETER :: ZeroCelsius = 273.15       !! Freezing point (C)
+  REAL(r_std),PARAMETER :: euler = 2.71828182846      !! e = EXP(1.) (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 (unitless)
+  REAL(r_std),PARAMETER :: undef = -9999.             !! Special value (unitless)
+!-
+  REAL(r_std),PARAMETER :: tlong_ref_max=303.1        !! maximum reference long term temperature (K)
+  REAL(r_std),PARAMETER :: tlong_ref_min=253.1        !! minimum reference long term temperature (K)
+!-
+!! trees and litter: indices for the parts of heart- and sapwood above
+!! and below the ground (unitless)
+  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 (unitless)
+  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 (unitless)
+  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)
+!-
+!! 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)
+
+!-
+!! [DISPENSABLE] transformation between types of surface (unitless)
+  INTEGER(i_std),PARAMETER :: ito_natagri = 1
+  INTEGER(i_std),PARAMETER :: ito_total = 2
+!-
+  INTEGER(i_std),PARAMETER :: nleafages = 4     !! leaf age discretisation ( 1 = no discretisation )(unitless)
+!- 
+  REAL(r_std),PARAMETER :: alpha_grass = .5     !! alpha coefficient for grasses (unitless)
+  REAL(r_std),PARAMETER :: alpha_tree = 1.      !! alpha coefficient for trees (unitless)
+!-
+  TYPE t_photo_type                             !! type declaration for photosynthesis
+    REAL(r_std), DIMENSION(nvm) :: t_max_a      
+    REAL(r_std), DIMENSION(nvm) :: t_max_b
+    REAL(r_std), DIMENSION(nvm) :: t_max_c
+    REAL(r_std), DIMENSION(nvm) :: t_opt_a
+    REAL(r_std), DIMENSION(nvm) :: t_opt_b
+    REAL(r_std), DIMENSION(nvm) :: t_opt_c
+    REAL(r_std), DIMENSION(nvm) :: t_min_a
+    REAL(r_std), DIMENSION(nvm) :: t_min_b
+    REAL(r_std), DIMENSION(nvm) :: t_min_c
+  END TYPE t_photo_type
+!-
+  TYPE pheno_type                                                    !! type declaration for phenology 
+    REAL(r_std), DIMENSION(nvm,3)    :: gdd                          
+    REAL(r_std), DIMENSION(nvm)      :: ngd                          
+    REAL(r_std), DIMENSION(nvm)      :: ncdgdd_temp
+    REAL(r_std), DIMENSION(nvm)      :: hum_frac
+    REAL(r_std), DIMENSION(nvm)      :: lowgpp_time
+    REAL(r_std), DIMENSION(nvm)      :: leaffall
+    REAL(r_std), DIMENSION(nvm)      :: leafagecrit
+    REAL(r_std)                      :: tau_hum_month
+    REAL(r_std)                      :: tau_hum_week
+    REAL(r_std)                      :: tau_t2m_month
+    REAL(r_std)                      :: tau_t2m_week
+    REAL(r_std)                      :: tau_tsoil_month
+    REAL(r_std)                      :: tau_soilhum_month
+    REAL(r_std)                      :: tau_gpp_week
+    REAL(r_std)                      :: tau_gdd
+    REAL(r_std)                      :: tau_ngd
+    REAL(r_std)                      :: tau_longterm
+    REAL(r_std), DIMENSION(nvm)      :: lai_initmin
+    CHARACTER(len=6), DIMENSION(nvm) :: pheno_model
+    CHARACTER(len=6), DIMENSION(nvm) :: senescence_type
+    REAL(r_std), DIMENSION(nvm,3)    :: senescence_temp
+    REAL(r_std), DIMENSION(nvm)      :: senescence_hum
+    REAL(r_std), DIMENSION(nvm)      :: nosenescence_hum
+    REAL(r_std), DIMENSION(nvm)      :: max_turnover_time
+    REAL(r_std), DIMENSION(nvm)      :: min_leaf_age_for_senescence
+    REAL(r_std), DIMENSION(nvm)      :: min_turnover_time
+!-
+    REAL(r_std), DIMENSION(nvm)      :: hum_min_time
+  END TYPE pheno_type
+!-
+! parameters for the pipe model
+!-
+  REAL(r_std),PARAMETER :: pipe_tune1 = 100.0        !! crown area = pipe_tune1. stem diameter**(1.6) (Reineke's theory)(unitless)
+  REAL(r_std),PARAMETER :: pipe_tune2 = 40.0         !! height=pipe_tune2 * diameter**pipe_tune3 (unitless)
+  REAL(r_std),PARAMETER :: pipe_tune3 = 0.5          !! height=pipe_tune2 * diameter**pipe_tune3 (unitless)
+  REAL(r_std),PARAMETER :: pipe_tune4 = 0.3          !! needed for stem diameter (unitless)
+  REAL(r_std),PARAMETER :: pipe_density = 2.e5       !! Density (unitless)
+  REAL(r_std),PARAMETER :: pipe_k1 = 8.e3            !! one more parameter (unitless)
+!-
+  REAL(r_std),PARAMETER :: estab_max_tree = 0.12     !! Maximum tree establishment rate (0-1, unitless)
+  REAL(r_std),PARAMETER :: estab_max_grass = 0.12    !! Maximum grass establishment rate (0-1, unitless)
+  REAL(r_std),PARAMETER :: ind_0 = 0.02              !! initial density of individuals (m^{-2})
+  REAL(r_std), PARAMETER :: npp_min = 100.           !! min npp to test competition between grass 
+                                                     !! @tex $(gC.m^{-2}.day^{-1})$ @endtex
+!-
+  LOGICAL,SAVE :: treat_expansion = .FALSE.          !! Do we treat PFT expansion across a grid point after introduction? (true/false)
+! default = .FALSE.
+
+  LOGICAL, SAVE :: lpj_gap_const_mort = .TRUE.       !! Do we treat calculate constant mortality if vegetation is static? (true/false)
+! default = .TRUE.
+!-
+  LOGICAL,SAVE :: ok_herbivores = .FALSE.            !! herbivores? (true/false)
+!-
+  LOGICAL,SAVE :: harvest_agri = .TRUE.              !! harvesting ? (true/false)
+!-
+  REAL(r_std),PARAMETER :: 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. 
+!-
+! climatic parameters
+!-
+  REAL(r_std),PARAMETER :: precip_crit = 100.                 !! minimum precip (mm/year)
+  REAL(r_std),PARAMETER :: gdd_crit = 150.                    !! minimum gdd for establishment of saplings (days)
+  REAL(r_std),PARAMETER :: fpc_crit = 0.95                    !! critical foliage projective cover, needed for light competition
+                                                              !! and establishment (0-100, unitless)
+!-
+  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)
+!-
+  REAL(r_std),PARAMETER :: frac_growthresp = 0.28             !! fraction of GPP which is lost as growth respiration (0-1, unitless)
+!-
+  REAL(r_std),PARAMETER :: min_avail = 0.02                   !! minimum availability to calculate mortality (??units??)
+!-
+  CHARACTER(len=34), SAVE, DIMENSION(nvm)  :: PFT_name = &                    !! description of the PFT (unitless)
+ & (/ 'bared 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
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: ext_coeff                        !! extinction coefficient of the Monsi&Saeki (1953)
+                                                                               !! relationship (unitless)
+
+  LOGICAL, SAVE, DIMENSION(nvm)            :: tree                             !! is pft a tree (true/false)
+
+  INTEGER(i_std), SAVE, DIMENSION(nvm)     :: leaf_tab = &                     !! leaf type (1-4, unitless)
+                                                                               !! values : 1=broad leaved tree, 2=needle leaved tree,
+                                                                               !! values : 3=grass 4=bare ground
+ & (/      4,       1,       1,       2,       1,       1,       2,   &
+ &                  1,       2,       3,       3,       3,       3 /)
+
+  LOGICAL, SAVE, DIMENSION(nvm)            :: natural =    &                   !! natural?  (true/false)
+ & (/  .TRUE.,  .TRUE.,  .TRUE.,  .TRUE.,  .TRUE.,  .TRUE.,  .TRUE.,   &
+ &              .TRUE.,  .TRUE.,  .TRUE.,  .TRUE., .FALSE., .FALSE. /)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: flam                             !! flamability: critical fraction of water 
+                                                                               !! holding capacity (0-1, unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: resist                           !! fire resistance (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: sla                              !! specific leaf area @tex $(m^2.gC^{-1})$ @endtex
+
+  REAL(r_std), SAVE, DIMENSION(nvm,nparts) :: bm_sapl                          !! sapling biomass  @tex $(gC.ind^{-1})$ @endtex
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: migrate                          !! migration speed @tex $(m.year^{-1})$ @endtex
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: maxdia                           !! maximum stem diameter from which on crown 
+                                                                               !! area no longer increases (m)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: cn_sapl                          !! crown of tree when sapling @tex $(m^2)$ @endtex
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tmin_crit                        !! critical minimum temperature (K)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tcm_crit                         !! critical temperature of the coldest month (K)
+
+  TYPE(pheno_type),SAVE :: pheno_crit                                          !! critical values for phenology (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: leaf_timecst                     !! time constant for leaf age discretisation (days)
+
+  REAL(r_std), SAVE, DIMENSION (nvm)       :: lai_max                          !! maximum LAI, PFT-specific @tex $(m^2.m^{-2})$ @endtex
+
+  REAL(r_std), SAVE, DIMENSION(nvm,nparts) :: coeff_maint_zero                 !! maintenance respiration coefficient at 0 deg C 
+                                                                               !! @tex $(g.g^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), SAVE, DIMENSION(nvm,3)      :: maint_resp_slope                 !! slope of maintenance respiration 
+                                                                               !! coefficient (1/K, 1/K^2, 1/K^3)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: residence_time                   !! residence time of trees (y)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: leaflife_tab                     !! leaf lifetime, tabulated (days)
+ 
+  INTEGER(i_std), SAVE, DIMENSION(nvm)     :: pheno_type_tab                   !! type of phenology (0-4, unitless)
+                                                                               !! values: 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"
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tmin_crit_tab                    !! critical tmin, tabulated (C)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tcm_crit_tab                     !! critical tcm, tabulated (C)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: gdd_crit1_tab                    !! critical gdd, tabulated (C),  
+                                                                               !! constant c of aT^2+bT+c (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: gdd_crit2_tab                    !! critical gdd, tabulated (C), 
+                                                                               !! constant b of aT^2+bT+c (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: gdd_crit3_tab                    !! critical gdd, tabulated (C), 
+                                                                               !! constant a of aT^2+bT+c (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: ngd_crit_tab                     !! critical ngd, tabulated. Threshold -5 degrees (C)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: ncdgdd_temp_tab                  !! critical temperature for the ncd vs. gdd 
+                                                                               !! function in phenology (C)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: hum_frac_tab                     !! critical humidity (relative to min/max) for phenology
+                                                                               !! (0-1, unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: lowgpp_time_tab                  !! minimum duration of dormance for phenology (days)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: hum_min_time_tab                 !! minimum time elapsed since moisture minimum (days)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tau_sap                          !! sapwood -> heartwood conversion time (days)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tau_fruit                        !! fruit lifetime (days)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: ecureuil                         !! fraction of primary leaf and root allocation 
+                                                                               !! put into reserve (0-1, unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: vcmax_opt                        !! Maximum rate of carboxylation @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: vjmax_opt                        !! Maximum rate of RUbp regeneration @tex $(\mu mol.m^{-2}.s^{-1})$ @endtex
+
+!-
+  TYPE(t_photo_type), SAVE                 :: t_photo                          !! constants needed for photosynthesis temperatures (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: leaffall_tab                     !! length of death of leaves, tabulated (days)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: leafagecrit_tab                  !! critical leaf age, tabulated (days)
+
+  CHARACTER(len=6), SAVE, DIMENSION(nvm)   :: pheno_model_tab                  !! which phenology model is used? (tabulated)(unitless)
+! List of avaible phenology models :
+! 'hum   ', 'moi   ', 'ncdgdd', 'ngd   ', 'humgdd', 'moigdd', 'none  '
+
+  CHARACTER(len=6), SAVE, DIMENSION(nvm)   :: senescence_type_tab              !! type of senescence, tabulated (unitless)
+!-
+! List of avaible types of senescence :
+! 'cold  ', 'dry   ', 'mixed ', 'none  '
+
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: senescence_temp1_tab             !! critical temperature for senescence (C), 
+                                                                               !! constant c of aT^2+bT+c , tabulated
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: senescence_temp2_tab             !! critical temperature for senescence (C),
+                                                                               !! constant b of aT^2+bT+c , tabulated
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: senescence_temp3_tab             !! critical temperature for senescence (C), 
+                                                                               !! constant a of aT^2+bT+c , tabulated
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: senescence_hum_tab               !! critical relative moisture availability 
+                                                                               !! for senescence (0-1, unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: nosenescence_hum_tab             !! relative moisture availability above which 
+                                                                               !! there is no humidity-related senescence (0-1, unitless)
+
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: max_turnover_time_tab            !! maximum turnover time for grasse (days)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: min_turnover_time_tab            !! minimum turnover time for grasse (days)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: min_leaf_age_for_senescence_tab  !! minimum leaf age to allow senescence g (days)
+
+!-
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: maint_resp_slope1_tab            !! slope of maintenance respiration coefficient (1/K),
+                                                                               !! constant c of aT^2+bT+c , tabulated
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: maint_resp_slope2_tab            !! slope of maintenance respiration coefficient (1/K),
+                                                                               !! constant b of aT^2+bT+c , tabulated
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: maint_resp_slope3_tab            !! slope of maintenance respiration coefficient (1/K)
+                                                                               !! constant a of aT^2+bT+c , tabulated
+
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: cm_zero_leaf_tab                 !! maintenance respiration coefficient at 0 deg C,
+                                                                               !! for leaves, tabulated  @tex $(g.g^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: cm_zero_sapabove_tab             !! maintenance respiration coefficient at 0 deg C, 
+                                                                               !! for sapwood above, tabulated @tex $(g.g^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: cm_zero_sapbelow_tab             !! maintenance respiration coefficient at 0 deg C, 
+                                                                               !! for sapwood below, tabulated @tex $(g.g^{-1}.day^{-1})$ @endtex
+
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: cm_zero_heartabove_tab           !! maintenance respiration coefficient at 0 deg C,
+                                                                               !! for heartwood above, tabulated @tex $(g.g^{-1}.day^{-1})$ @endtex 
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: cm_zero_heartbelow_tab           !! maintenance respiration coefficient at 0 deg C, 
+                                                                               !! for heartwood below, tabulated @tex $(g.g^{-1}.day^{-1})$ @endtex  
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: cm_zero_root_tab                 !! maintenance respiration coefficient at 0 deg C,
+                                                                               !! for roots, tabulated @tex $(g.g^{-1}.day^{-1})$ @endtex  
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: cm_zero_fruit_tab                !! maintenance respiration coefficient at 0 deg C,
+                                                                               !! for fruits, tabulated @tex $(g.g^{-1}.day^{-1})$ @endtex
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: cm_zero_carbres_tab              !! maintenance respiration coefficient at 0 deg C, 
+                                                                               !! for carbohydrate reserve, tabulated  @tex $(g.g^{-1}.day^{-1})$ @endtex
+
+!-
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tphoto_min_a_tab                 !! minimum photosynthesis temperature, 
+                                                                               !! constant a of ax^2+bx+c (deg C), tabulated (unitless)
+
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tphoto_min_b_tab                 !! minimum photosynthesis temperature,
+                                                                               !! constant b of ax^2+bx+c (deg C), tabulated (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tphoto_min_c_tab                 !! minimum photosynthesis temperature, 
+                                                                               !! constant c of ax^2+bx+c (deg C), tabulated (unitless)
+
+!-
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tphoto_opt_a_tab                 !! optimum photosynthesis temperature, 
+                                                                               !! constant a of ax^2+bx+c (deg C), tabulated (unitless)
+
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tphoto_opt_b_tab                 !! optimum photosynthesis temperature, 
+                                                                               !! constant b of ax^2+bx+c (deg C), tabulated (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tphoto_opt_c_tab                 !! optimum photosynthesis temperature, 
+                                                                               !! constant c of ax^2+bx+c (deg C), tabulated (unitless)
+
+!-
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tphoto_max_a_tab                 !! maximum photosynthesis temperature, 
+                                                                               !! constant a of ax^2+bx+c (deg C), tabulated (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tphoto_max_b_tab                 !! maximum photosynthesis temperature, 
+                                                                               !! constant b of ax^2+bx+c (deg C), tabulated (unitless)
+
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: tphoto_max_c_tab                 !! maximum photosynthesis temperature, 
+                                                                               !! constant c of ax^2+bx+c (deg C), tabulated (unitless)
+
+!! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF (??units??)
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: alloc_min 
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: alloc_max 
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: demi_alloc 
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: coeff_lcchange_1                 !! Coeff of biomass export for the year (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: coeff_lcchange_10                !! Coeff of biomass export for the decade (unitless)
+
+  REAL(r_std), SAVE, DIMENSION(nvm)        :: coeff_lcchange_100               !! Coeff of biomass export for the century (unitless)
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_constants_init
+!!
+!>\BRIEF          This subroutine initializes the pft parameters used by STOMATE.
+!!
+!! DESCRIPTION  : This subroutine is called by the subroutine stomate_init.f90. \n
+!!                Only the values of vcmax_opt can be modified in the configuration file
+!!                ("run.def") without having to recompile the code.\n
+!!                For technical reasons, (bare soil not used in STOMATE), the values
+!!                of the parameters for the PFT 1 are not defined.\n
+!!                Called at the first call of stomate.f90. \n
+!!
+!! RECENT CHANGE(S): Sonke Zaehle - 1.9.3 new maint_resp_slope1_tab values
+!!
+!! MAIN OUTPUT VARIABLE(S): 
+!!
+!! REFERENCE(S) :
+!! - Krinner, G., Viovy, N., Noblet-Ducoudre, N. de, Ogee, J., Polcher, J., Friedlingstein,
+!! P., Ciais, 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
+!!
+!! FLOWCHART    :None
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE stomate_constants_init ()
+  ! flamability: critical fraction of water holding capacity
+  flam(2:nvm) =       &
+ & (/      .15,     .25,     .25,     .25,     .25,     .25,   &
+           .25,     .25,     .25,     .25,     .35,     .35 /)
+!  flam(2:nvm) =       &
+! & (/        .25,     .25,     .25,     .25,     .25,     .25,   &
+!                   .25,     .25,     .30,     .30,     .35,     .35 /)
+!  flam =       &
+! & (/        .15,     .15,     .15,     .15,     .15,     .15,   &
+! &                 .15,     .15,     .15,     .15,     .15,     .15 /)
+  ! fire resistance
+  resist(2:nvm) =     &
+ & (/     .95,     .90,     .12,     .50,     .12,     .12,   &
+ &        .12,     .12,      .0,      .0,      .0,      .0 /)
+!  resist(2:nvm) =     &
+! & (/        .12,     .50,     .12,     .50,     .12,     .12,   &
+! &                 .12,     .12,      .0,      .0,      .0,      .0 /)
+! maximum LAI, PFT-specific
+  lai_max(:) =   &
+ & (/     undef, &
+ &          7.,     7.,      5.,      5.,      5.,     4.5, &
+ &        4.5,    3.0,     2.5,     2.5,     5.,     5.  /)
+! residence time (y) of trees
+  residence_time(2:nvm) =    &
+ & (/    30.0,    30.0,    40.0,    40.0,    40.0,    80.0, &
+ &       80.0,    80.0,     0.0,     0.0,     0.0,     0.0 /)
+! leaf lifetime, tabulated
+!SZ modif to LPJ values
+  leaflife_tab(2:nvm) =      &
+ & (/        .5,      2.,     .33,      1.,     2.,      .33,   &
+ &           2.,      2.,      2.,      2.,     2.,        2. /)
+!  leaflife_tab(2:nvm) =      &
+! & (/      .5,      1.,      .5,      .5,      1.,      .5, &
+! &        1.,       1.,      1.,      1.,      1.,     1.  /)
+! type of phenology
+! 0=bared ground 1=evergreen,  2=summergreen,  3=raingreen,  4=perennial
+! Pour l'instant, le phÃ©notype de sol nu n'est pas gÃ©rÃ© aussi on traitera les sols nu comme "evergreen"
+  pheno_type_tab(2:nvm) =    &
+ & (/      1,        3,       1,       1,       2,       1, &
+ &         2,        2,       4,       4,       2,       3 /)
+! critical tmin, tabulated (C)
+  tmin_crit_tab(2:nvm) =    &
+ & (/     0.0,     0.0,   -30.0,   -14.0,   -30.0,   -45.0, &
+ &      -45.0,   undef,   undef,   undef,   undef,   undef /)
+! critical tcm, tabulated (C)
+  tcm_crit_tab(2:nvm) =     &
+ & (/   undef,   undef,     5.0,    15.5,    15.5,    -8.0, &
+ &        -8.0,    -8.0,   undef,   undef,   undef,   undef /)
+! critical gdd, tabulated (C), constant c of aT^2+bT+c
+  gdd_crit1_tab(2:nvm) =    &
+ & (/   undef,   undef,   undef,   undef,   undef,   undef, &
+ &      undef,   undef,     270.,   400.,    125.,    400. /)
+! gdd_crit1_tab(2:nvm) = &
+! & (/   undef,   undef,   undef,   undef,   undef,   undef, &
+! &      undef,   undef, 184.375,    400.,    125.,    400. /)
+! critical gdd, tabulated (C), constant b of aT^2+bT+c
+  gdd_crit2_tab(2:nvm) =    &
+ & (/   undef,   undef,   undef,   undef,   undef,   undef, &
+ &      undef,   undef,    6.25,      0.,      0.,       0. /)
+! critical gdd, tabulated (C), constant a of aT^2+bT+c
+  gdd_crit3_tab(2:nvm) =    &
+ & (/   undef,   undef,   undef,   undef,   undef,   undef, &
+ &      undef,   undef, 0.03125,      0.,      0.,       0. /)
+! critical ngd, tabulated. Threshold -5 degrees
+  ngd_crit_tab(2:nvm)  =    &
+ & (/   undef,   undef,   undef,   undef,   undef,   undef, &
+ &      undef,     17.,   undef,   undef,   undef,   undef /)
+! critical temperature for the ncd vs. gdd function in phenology
+  ncdgdd_temp_tab(2:nvm) =  &
+ & (/   undef,   undef,   undef,   undef,      5.,   undef, &
+ &         0.,   undef,   undef,   undef,   undef,   undef /)
+! critical humidity (relative to min/max) for phenology
+  hum_frac_tab(2:nvm) =     &
+ & (/      undef,      .5,   undef,   undef,   undef,   undef,         &
+ &         undef,   undef,      .5,      .5,      .5,      .5         /)
+! minimum duration of dormance (d) for phenology
+  lowgpp_time_tab(2:nvm) =  &
+ & (/      undef,     30.,   undef,   undef,     30.,   undef,   &
+ &           30.,     30.,     30.,     30.,     30.,     30. /)
+! minimum time elapsed since moisture minimum (d)
+  hum_min_time_tab(2:nvm) =   &
+ & (/      undef,     50.,   undef,   undef,   undef,   undef,           &
+ &         undef,   undef,     35.,     35.,     75.,     75.           /)
+! sapwood -> heartwood conversion time (d)
+  tau_sap(2:nvm) =       &
+ & (/       730.,    730.,    730.,    730.,    730.,    730.,      &
+ &          730.,    730.,   undef,   undef,   undef,   undef      /)
+! fruit lifetime (d)
+  tau_fruit(2:nvm) =     &
+ & (/        90.,     90.,     90.,     90.,     90.,     90.,      &
+ &           90.,     90.,   undef,   undef,   undef,   undef      /)
+! fraction of primary leaf and root allocation put into reserve
+  ecureuil(2:nvm) =      &
+ & (/         .0,      1.,      .0,      .0,      1.,      .0,      &
+ &            1.,      1.,      1.,      1.,      1.,      1.      /)
+! Maximum rate of carboxylation
+  !Config Key  = vcmax_opt
+  !Config Desc = Maximum rate of carboxylation
+  !Config Def  = undef, 65., 65., 35., 45., 55., 35., 45., 35., 70., 70., 70., 70.
+  !Config Help = 
+  !
+!Shilong
+  vcmax_opt(:) =     &
+ & (/      undef, &
+ &         65.,     65.,     35.,     45.,     55.,     35.,      &
+ &         45.,     35.,     70.,     70.,    70.,    70.      /)
+  CALL getin_p("vcmax_opt", vcmax_opt)
+! 1.9.3
+!  vcmax_opt(2:nvm) =     &
+! & (/     65.,     65.,     35.,     40.,     55.,     35.,   &
+! &        45.,     35.,     70.,     70.,     70.,     70. /
+! OLD HEAD before 1.9.3
+!  vcmax_opt(2:nvm) =     &
+! & (/        65.,     65.,     35.,     40.,     55.,     35.,      &
+! &                 45.,     35.,     80.,     80.,    100.,    100.      /)
+!modif jerome carbofor
+! vcmax_opt = &
+! & (/        65.,     65.,     50.,     40.,     75.,     35.,   &
+! &           45.,     35.,     80.,     80.,    100.,    100. /)
+!DATA vcmax_opt_tab          /      0.,     65.,     65.,    37.5,     45.,     60.,    37.5,   &
+!                                  50.,     40.,    100.,    100.,    100.,    100. / 
+!-
+! Maximum rate of RUbp regeneration
+  vjmax_opt(2:nvm) =     &
+ & (/       130.,    130.,     70.,     80.,    110.,     70.,      &
+ &           90.,     70.,    160.,    160.,    200.,    200.      /)
+!-
+!DATA vjmax_opt_tab          /      0.,    130.,    130.,     75.,     90.,    120.,     75.,   &
+!                                 100.,     80.,    200.,    200.,    200.,    200. /
+!-
+! length of death of leaves, tabulated (d)
+  leaffall_tab(2:nvm) =    &
+ & (/      undef,     10.,   undef,   undef,     10.,   undef,        &
+ &           10.,     10.,     10.,     10.,     10.,     10.        /)
+! critical leaf age, tabulated (d)
+! Shilong modification
+  leafagecrit_tab(2:nvm) =     &
+ & (/       730.,    180.,    910.,    730.,    180.,    910.,            &
+ &          180.,    180.,    120.,    120.,    90.,    90.            /)
+! OLD HEAD
+!  DATA leafagecrit_tab        /    730.,    180.,    910.,    730.,    180.,    910.,   &
+!                                   180.,    180.,    120.,    120.,    120.,    120. /
+!NEW SHILONG
+! & (/     730.,    180.,    910.,    730.,    180.,    910.,            &
+! &        180.,    180.,    120.,    120.,     70.,     70.            /)
+!-
+  ! which phenology model is used? (tabulated)
+  pheno_model_tab(1:nvm) =   &
+ & (/  'none  ',   'none  ',   'moi   ',   'none  ',   'none  ',   &
+ &     'ncdgdd',   'none  ',   'ncdgdd',   'ngd   ',   'moigdd',   &
+ &     'moigdd',   'moigdd',   'moigdd'           /) 
+! List of avaible phenology models :
+! 'hum   ', 'moi   ', 'ncdgdd', 'ngd   ', 'humgdd', 'moigdd', 'none  '
+!-
+  ! type of senescence, tabulated
+  senescence_type_tab(1:nvm) =   &
+ & (/  'none  ',  'none  ',   'dry   ',  'none  ',  'none  ',   &
+ &     'cold  ',  'none  ',   'cold  ',  'cold  ',  'mixed ',   &
+ &     'mixed ',  'mixed ',   'mixed '            /)
+!-
+! List of avaible types of senescence :
+! 'cold  ', 'dry   ', 'mixed ', 'none  '
+!-
+! critical temperature for senescence (C),
+! constant c of aT^2+bT+c , tabulated
+  senescence_temp1_tab(2:nvm) =   &
+ & (/      undef,   undef,   undef,   undef,     12.,   undef,               &
+ &            7.,      2.,  -1.375,      5.,      5.,     10.               /)
+! critical temperature for senescence (C),
+! constant b of aT^2+bT+c , tabulated
+  senescence_temp2_tab(2:nvm) =   &
+ & (/      undef,   undef,   undef,   undef,      0.,   undef,               &
+ &            0.,      0.,      .1,      0.,      0.,      0.               /)
+! critical temperature for senescence (C),
+! constant a of aT^2+bT+c , tabulated
+  senescence_temp3_tab(2:nvm) =   &
+ & (/      undef,   undef,   undef,   undef,      0.,   undef,               &
+ &            0.,      0.,  .00375,      0.,      0.,      0.               /)
+! critical relative moisture availability for senescence
+!SZ 080806, reparameterisation of TrBR: reduce criticial moisture from .6 to .3 
+! to mimic a leaf dropping at -1.49 MPa, buffered to account for sechiba
+  senescence_hum_tab(2:nvm) =  &
+ & (/      undef,      .3,   undef,   undef,   undef,   undef,            &
+ &         undef,   undef,      .2,      .2,      .3,      .2            /)
+! 1.9.3
+!  senescence_hum_tab(2:nvm) =  &
+! & (/      undef,      .6,   undef,   undef,   undef,   undef,            &
+! &         undef,   undef,      .2,      .2,      .3,      .2            /)
+! relative moisture availability above which
+! there is no humidity-related senescence
+!SZ 080806, reparameterisation of TrBR: reduce nosenencemoisture to avoid leaf dropping
+! when phenology routine would give new flushing of leaves: 1.0 to 0.8
+  nosenescence_hum_tab(2:nvm) =  &
+ & (/      undef,      .8,   undef,   undef,   undef,   undef,              &
+ &               undef,   undef,      .3,      .3,      .3,      .3              /)
+! 1.9.3
+!  nosenescence_hum_tab(2:nvm) =  &
+! & (/      undef,      1.,   undef,   undef,   undef,   undef,              &
+! &               undef,   undef,      .3,      .3,      .3,      .3              /)
+
+! maximum turnover time for grasse
+  max_turnover_time_tab(2:nvm) =   &
+ & (/      undef,   undef,    undef,   undef,   undef,   undef,                &
+ &         undef,   undef,      80.,     80.,     80.,     80.                /)
+! minimum turnover time for grasse
+  min_turnover_time_tab(2:nvm) =   &
+ & (/      undef,    undef,    undef,    undef,   undef,   undef,              &
+ &         undef,   undef,      10.,      10.,      10.,      10.             /)
+! minimum leaf age to allow senescence g
+  min_leaf_age_for_senescence_tab(:) =   &
+ & (/    undef, &
+ &       undef,    90.,   undef,   undef,    90.,    undef,          &
+ &         60.,    60.,     30.,     30.,    30.,      30.          /)
+!-
+! slope of maintenance respiration coefficient (1/K),
+! constant c of aT^2+bT+c , tabulated
+!SZ - 1.9.3
+  maint_resp_slope1_tab(2:nvm) =   &
+ & (/        .12,     .12,     .16,     .16,     .16,     .16,                &
+ &           .16,     .16,     .16,     .12,     .16,     .12                /)
+!OLD MERGE
+!  maint_resp_slope1_tab(2:nvm) =   &
+! & (/        .16,     .16,     .16,     .16,     .16,     .16,                &
+! &                 .16,     .16,     .16,     .12,     .16,     .16                /)
+!Shilong
+!  maint_resp_slope1_tab(2:nvm) =   &
+! & (/      .12,     .12,     .16,     .16,     .16,     .16,                &
+! &         .16,     .16,     .16,     .16,     .16,     .16                /)
+!-
+! slope of maintenance respiration coefficient (1/K),
+! constant b of aT^2+bT+c , tabulated
+  maint_resp_slope2_tab(2:nvm) =   &
+ & (/         .0,      .0,      .0,      .0,      .0,      .0,                &
+ &            .0,      .0, -.00133,      .0, -.00133,      .0                /)
+  ! DATA maint_resp_slope2_tab  /      .0,      .0,      .0,      .0,      .0,      .0,      .0,   &
+  !                                    .0,      .0,      .0,      .0,      .0,      .0 /
+! slope of maintenance respiration coefficient (1/K),
+! constant a of aT^2+bT+c , tabulated
+  maint_resp_slope3_tab(2:nvm) =   &
+ & (/         .0,      .0,      .0,      .0,      .0,      .0,                &
+ &            .0,      .0,      .0,      .0,      .0,      .0                /)
+!-
+! maintenance respiration coefficient (g/g/day) at 0 deg C,
+! for leaves, tabulated
+  cm_zero_leaf_tab(2:nvm) =    &
+ & (/    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            /)
+!-
+! maintenance respiration coefficient (g/g/day) at 0 deg C,
+! for sapwood above, tabulated
+  cm_zero_sapabove_tab(2:nvm) =    &
+ & (/    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                /)
+!-
+! maintenance respiration coefficient (g/g/day) at 0 deg C,
+! for sapwood below, tabulated
+  cm_zero_sapbelow_tab(2:nvm) =    &
+ & (/    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                /)
+!-
+! maintenance respiration coefficient (g/g/day) at 0 deg C,
+! for heartwood above, tabulated
+  cm_zero_heartabove_tab(2:nvm) =  &
+ & (/         0.,      0.,      0.,      0.,      0.,      0.,                &
+ &            0.,      0.,      0.,      0.,      0.,      0.                /)
+!-
+! maintenance respiration coefficient (g/g/day) at 0 deg C,
+! for heartwood below, tabulated
+  cm_zero_heartbelow_tab(2:nvm) =  &
+ & (/         0.,      0.,      0.,      0.,      0.,      0.,                &
+ &            0.,      0.,      0.,      0.,      0.,      0.                /)
+!-
+! maintenance respiration coefficient (g/g/day) at 0 deg C,
+! for roots, tabulated
+  cm_zero_root_tab(2:nvm) =    &
+ & (/    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            /)
+!-
+! maintenance respiration coefficient (g/g/day) at 0 deg C,
+! for fruits, tabulated
+  cm_zero_fruit_tab(2:nvm) =   &
+ & (/    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            /)
+!-
+! maintenance respiration coefficient (g/g/day) at 0 deg C,
+! for carbohydrate reserve, tabulated
+  cm_zero_carbres_tab(2:nvm) =    &
+ & (/    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               /)
+!-
+! minimum photosynthesis temperature,
+! constant a of ax^2+bx+c (deg C), tabulated
+  tphoto_min_a_tab(2:nvm) =   &
+ & (/         0.,      0.,      0.,      0.,      0.,      0.,           &
+ &            0.,      0.,  0.0025,      0.,      0.,      0.           /)
+!-
+! minimum photosynthesis temperature,
+! constant b of ax^2+bx+c (deg C), tabulated
+  tphoto_min_b_tab(2:nvm) =   &
+ & (/         0.,      0.,      0.,      0.,      0.,      0.,           &
+ &            0.,      0.,     0.1,      0.,      0.,      0.           /)
+!-
+! minimum photosynthesis temperature,
+! constant c of ax^2+bx+c (deg C), tabulated
+  tphoto_min_c_tab(2:nvm) =   &
+ & (/         2.,      2.,     -4.,     -3.,     -2.,     -4.,           &
+ &           -4.,     -4.,   -3.25,     13.,     -5.,     13.           /)
+!-
+! optimum photosynthesis temperature,
+! constant a of ax^2+bx+c (deg C), tabulated
+  tphoto_opt_a_tab(2:nvm) =   &
+ & (/         0.,      0.,      0.,      0.,      0.,      0.,           &
+              0.,      0.,  0.0025,      0.,      0.,      0.           /)
+! optimum photosynthesis temperature,
+! constant b of ax^2+bx+c (deg C), tabulated
+  tphoto_opt_b_tab(2:nvm) =   &
+ & (/         0.,      0.,      0.,      0.,      0.,      0.,           &
+ &            0.,      0.,    0.25,      0.,      0.,      0.           /)
+!-
+! optimum photosynthesis temperature,
+! constant c of ax^2+bx+c (deg C), tabulated
+  tphoto_opt_c_tab(2:nvm) =    &
+ & (/        37.,     37.,     25.,     32.,     26.,     25.,           &
+ &           25.,     25.,   27.25,     36.,     30.,     36.           /)
+!-
+! maximum photosynthesis temperature,
+! constant a of ax^2+bx+c (deg C), tabulated
+  tphoto_max_a_tab(2:nvm) =    &
+ & (/         0.,      0.,      0.,      0.,      0.,      0.,             &
+ &            0.,      0., 0.00375,      0.,      0.,      0.            /)
+!-
+! maximum photosynthesis temperature,
+! constant b of ax^2+bx+c (deg C), tabulated
+  tphoto_max_b_tab(2:nvm) =    &
+ & (/         0.,      0.,      0.,      0.,      0.,      0.,            &
+ &            0.,      0.,    0.35,      0.,      0.,      0.            /)
+!-
+! maximum photosynthesis temperature,
+! constant c of ax^2+bx+c (deg C), tabulated
+  tphoto_max_c_tab(2:nvm) =    &
+ & (/        55.,     55.,     38.,     48.,     38.,     38.,            &
+ &           38.,     38.,  41.125,     55.,     45.,     55.            /)
+!-
+! NEW - allocation above/below = f(age) - 30/01/04 NV/JO/PF
+  alloc_min(2:nvm) =               &
+ & (/          0.2,       0.2,       0.2,       0.2,     0.2,     0.2,   &
+ &             0.2,       0.2,     undef,     undef,   undef,   undef   /)
+  alloc_max(2:nvm) =               &
+ & (/          0.8,       0.8,       0.8,       0.8,     0.8,     0.8,   &
+ &             0.8,       0.8,     undef,     undef,   undef,   undef   /)
+  demi_alloc(2:nvm) =              &
+ & (/           5.,        5.,       5.,        5.,       5.,      5.,   &
+ &              5.,        5.,    undef,     undef,    undef,   undef   /)
+
+! Coeff of biomass export for the year
+  coeff_lcchange_1(2:nvm) = &
+ & (/        0.597,     0.597,    0.597,     0.597,    0.597,   0.597,   &
+ &           0.597,     0.597,    0.597,     0.597,    0.597,   0.597   /)
+! Coeff of biomass export for the decade
+  coeff_lcchange_10(2:nvm) = &
+ & (/        0.403,     0.403,    0.299,     0.299,    0.299,   0.299,   &
+ &           0.299,     0.299,    0.299,     0.403,    0.299,   0.403   /)
+! Coeff of biomass export for the century
+  coeff_lcchange_100(2:nvm) = &
+ & (/           0.,        0.,    0.104,     0.104,    0.104,   0.104,   &
+ &           0.104,     0.104,    0.104,        0.,    0.104,      0.   /)
+
+  END SUBROUTINE stomate_constants_init
+
+!---------------------------
+END MODULE stomate_constants
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_data.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_data.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_data.f90	(revision 854)
@@ -0,0 +1,743 @@
+! =================================================================================================================================
+! 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_veg
+  USE constantes_co2
+  USE stomate_constants
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  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
+
+    REAL(r_std), PARAMETER                       :: x = 3.  !! mass ratio (heartwood+sapwood)/sapwood (unitless)
+
+    !! 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_crit% min_leaf_age_for_senescence(1) = min_leaf_age_for_senescence_tab(1)
+
+    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 ( leaf_tab(j) .LE. 2 ) THEN
+          tree(j) = .TRUE.
+       ELSE
+          tree(j) = .FALSE.
+       ENDIF !( leaf_tab(j) .LE. 2 )
+
+       IF ( bavard .GE. 1 ) WRITE(numout,*) '       tree: (::tree) ', 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))
+
+       ! 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 !( leaf_tab(j) .EQ. 2 )
+
+!$      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 ( tree(j) ) THEN
+
+          !> 5.1 trees
+
+          !!\latexonly
+          !!\input{stomate_data_sapl_tree.tex}
+          !!\endlatexonly
+
+          alpha = alpha_tree
+
+          bm_sapl(j,ileaf) = &
+               ( (4.*pipe_tune1 * ( x*4.*sla(j)/(pi*pipe_k1))**.8 ) / sla(j) ) ** 5.
+
+          IF ( pheno_type_tab(j) .NE. 1 ) THEN
+             ! not evergreen
+             bm_sapl(j,icarbres) = 5. * bm_sapl(j,ileaf)
+          ELSE
+             bm_sapl(j,icarbres) = zero
+          ENDIF ! (pheno_type_tab(j) .NE. 1 )
+
+          csa_sap = bm_sapl(j,ileaf) / ( pipe_k1 / sla(j) )
+
+          dia = ( x * csa_sap * 4. / pi ) ** 0.5
+
+          bm_sapl(j,isapabove) = &
+               .5 * pipe_density * csa_sap * pipe_tune2 * dia ** pipe_tune3
+          bm_sapl(j,isapbelow) = bm_sapl(j,isapabove)
+
+          bm_sapl(j,iheartabove) = 2. * bm_sapl(j,isapabove)
+          bm_sapl(j,iheartbelow) = 2. * bm_sapl(j,isapbelow)
+
+       ELSE
+
+          !> 5.2 grasses
+
+          !!\latexonly
+          !!\input{stomate_data_sapl_grass.tex}
+          !!\endlatexonly
+
+          alpha = alpha_grass
+
+          IF ( natural(j) ) THEN
+             bm_sapl(j,ileaf) = 0.1 / sla(j)
+          ELSE
+             bm_sapl(j,ileaf) = un / sla(j)
+          ENDIF
+
+          bm_sapl(j,icarbres) = 5.*bm_sapl(j,ileaf)
+
+          bm_sapl(j,isapabove) = zero
+          bm_sapl(j,isapbelow) = zero
+
+          bm_sapl(j,iheartabove) = zero
+          bm_sapl(j,iheartbelow) = zero
+
+       ENDIF !( tree(j) )
+
+       bm_sapl(j,iroot) = 0.1 * (1./alpha) * bm_sapl(j,ileaf)
+
+       bm_sapl(j,ifruit) = 0.3 * bm_sapl(j,ileaf)
+
+       IF ( bavard .GE. 1 ) THEN
+          WRITE(numout,*) '       sapling biomass (gC):'
+          WRITE(numout,*) '         leaves: (::bm_sapl(j,ileaf))',bm_sapl(j,ileaf)
+          WRITE(numout,*) '         sap above ground: (::bm_sapl(j,ispabove)):',bm_sapl(j,isapabove)
+          WRITE(numout,*) '         sap below ground: (::bm_sapl(j,isapbelow))',bm_sapl(j,isapbelow)
+          WRITE(numout,*) '         heartwood above ground: (::bm_sapl(j,iheartabove))',bm_sapl(j,iheartabove)
+          WRITE(numout,*) '         heartwood below ground: (::bm_sapl(j,iheartbelow))',bm_sapl(j,iheartbelow)
+          WRITE(numout,*) '         roots: (::bm_sapl(j,iroot))',bm_sapl(j,iroot)
+          WRITE(numout,*) '         fruits: (::bm_sapl(j,ifruit))',bm_sapl(j,ifruit)
+          WRITE(numout,*) '         carbohydrate reserve: (::bm_sapl(j,icarbres))',bm_sapl(j,icarbres)
+       ENDIF !( bavard .GE. 1 ) 
+
+       !
+       ! 6 migration speed (m/year)
+       !
+
+       IF ( tree(j) ) THEN
+
+          migrate(j) = 10.*1.E3
+
+       ELSE
+
+          ! can be any value as grasses are, per *definition*, everywhere (big leaf).
+          migrate(j) = 10.*1.E3
+
+       ENDIF !( 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 ( tree(j) ) THEN
+
+          !!\latexonly
+          !!\input{stomate_data_stem_diameter.tex}
+          !!\endlatexonly
+
+          maxdia(j) = ( ( pipe_tune4 / ((pipe_tune2*pipe_tune3)/(100.**pipe_tune3)) ) &
+               ** ( un / ( pipe_tune3 - un ) ) ) * 0.01
+          cn_sapl(j) =0.5 !crown of individual tree, first year
+
+       ELSE
+
+          maxdia(j) = undef
+          cn_sapl(j)=1
+
+       ENDIF !( 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_tab(j) - undef ) .GT. min_stomate ) THEN
+          tmin_crit(j) = tmin_crit_tab(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_tab(j) - undef ) .GT. min_stomate ) THEN
+          tcm_crit(j) = tcm_crit_tab(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
+
+       pheno_crit%pheno_model(j) = pheno_model_tab(j)
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       phenology model used: (::pheno_crit%pheno_model(j)) ',pheno_crit%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.
+
+       pheno_crit%gdd(j,1) = gdd_crit1_tab(j)
+       pheno_crit%gdd(j,2) = gdd_crit2_tab(j)
+       pheno_crit%gdd(j,3) = gdd_crit3_tab(j)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( ALL(pheno_crit%gdd(j,:) .NE. undef) ) ) THEN
+          WRITE(numout,*) '         critical GDD is a function of long term T (C): (::pheno_crit%gdd)'
+          WRITE(numout,*) '          ',pheno_crit%gdd(j,1), &
+               ' + T *',pheno_crit%gdd(j,2), &
+               ' + T^2 *',pheno_crit%gdd(j,3)
+       ENDIF
+
+       ! consistency check
+
+       IF ( ( ( pheno_crit%pheno_model(j) .EQ. 'moigdd' ) .OR. &
+            ( pheno_crit%pheno_model(j) .EQ. 'humgdd' )       ) .AND. &
+            ( ANY(pheno_crit%gdd(j,:) .EQ. undef) )                      ) THEN
+          STOP 'problem with phenology parameters, critical GDD. (::pheno_crit%pheno_model)'
+       ENDIF
+
+       ! 10.3 number of growing days
+
+       pheno_crit%ngd(j) = ngd_crit_tab(j)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%ngd(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical NGD: (::pheno_crit%ngd(j))', pheno_crit%ngd(j)
+
+       ! 10.4 critical temperature for ncd vs. gdd function in phenology (C)
+
+       pheno_crit%ncdgdd_temp(j) = ncdgdd_temp_tab(j)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%ncdgdd_temp(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical temperature for NCD vs. GDD (C): (::pheno_crit%ncdgdd_temp(j))', &
+            pheno_crit%ncdgdd_temp(j)
+
+       ! 10.5 humidity fractions (0-1, unitless)
+
+       pheno_crit%hum_frac(j) = hum_frac_tab(j)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%hum_frac(j) .NE. undef ) ) &
+            WRITE(numout,*) '         critical humidity fraction: (::pheno_crit%hum_frac(j))', &
+            &  pheno_crit%hum_frac(j)
+
+       ! 10.6 minimum time during which there was no photosynthesis (days)
+
+       pheno_crit%lowgpp_time(j) = lowgpp_time_tab(j)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%lowgpp_time(j) .NE. undef ) ) &
+            WRITE(numout,*) '         minimum dormance duration (d): (::pheno_crit%lowgpp_time(j))', &
+       & pheno_crit%lowgpp_time(j)
+
+       ! 10.7 minimum time elapsed since moisture minimum (days)
+
+       pheno_crit%hum_min_time(j) = hum_min_time_tab(j)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%hum_min_time(j) .NE. undef ) ) &
+            WRITE(numout,*) '         time to wait after moisture min (d): (::pheno_crit%hum_min_time(j))', &
+        &    pheno_crit%hum_min_time(j)
+
+       !
+       ! 11 critical values for senescence
+       !
+
+       ! 11.1 type of senescence
+
+       pheno_crit%senescence_type(j) = senescence_type_tab(j)
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       type of senescence: (::pheno_crit%senescence_type(j))',pheno_crit%senescence_type(j)
+
+       ! 11.2 critical temperature for senescence (C)
+
+       pheno_crit%senescence_temp(j,1) = senescence_temp1_tab(j)
+       pheno_crit%senescence_temp(j,2) = senescence_temp2_tab(j)
+       pheno_crit%senescence_temp(j,3) = senescence_temp3_tab(j)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( ALL(pheno_crit%senescence_temp(j,:) .NE. undef) ) ) THEN
+          WRITE(numout,*) '         critical temperature for senescence (C) is'
+          WRITE(numout,*) '          a function of long term T (C): (::pheno_crit%senescence_temp)'
+          WRITE(numout,*) '          ',pheno_crit%senescence_temp(j,1), &
+               ' + T *',pheno_crit%senescence_temp(j,2), &
+               ' + T^2 *',pheno_crit%senescence_temp(j,3)
+       ENDIF
+
+       ! consistency check
+
+       IF ( ( ( pheno_crit%senescence_type(j) .EQ. 'cold' ) .OR. &
+            ( pheno_crit%senescence_type(j) .EQ. 'mixed' )      ) .AND. &
+            ( ANY(pheno_crit%senescence_temp(j,:) .EQ. undef ) )           ) THEN
+          STOP 'problem with senescence parameters, temperature. (::pheno_crit%senescence_type)'
+       ENDIF
+
+       ! 11.3 critical relative moisture availability for senescence
+
+       pheno_crit%senescence_hum(j) = senescence_hum_tab(j)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%senescence_hum(j) .NE. undef ) ) &
+            WRITE(numout,*)  ' max. critical relative moisture availability for' 
+            WRITE(numout,*)  ' senescence: (::pheno_crit%senescence_hum(j))',  &
+            & pheno_crit%senescence_hum(j)
+
+       ! consistency check
+
+       IF ( ( ( pheno_crit%senescence_type(j) .EQ. 'dry' ) .OR. &
+            ( pheno_crit%senescence_type(j) .EQ. 'mixed' )     ) .AND. &
+            ( pheno_crit%senescence_hum(j) .EQ. undef )                   ) THEN
+          STOP 'problem with senescence parameters, humidity.(::pheno_crit%senescence_type)'
+       ENDIF
+
+       ! 14.3 relative moisture availability above which there is no moisture-related
+       !      senescence (0-1, unitless)
+
+       pheno_crit%nosenescence_hum(j) = nosenescence_hum_tab(j)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%nosenescence_hum(j) .NE. undef ) ) &
+            WRITE(numout,*) '         relative moisture availability above which there is' 
+            WRITE(numout,*) '             no moisture-related senescence: (::pheno_crit%nosenescence_hum(j))', &
+            &  pheno_crit%nosenescence_hum(j)
+
+       pheno_crit% max_turnover_time(j) = max_turnover_time_tab(j)
+       pheno_crit% min_turnover_time(j) = min_turnover_time_tab(j)
+       pheno_crit% min_leaf_age_for_senescence(j) = min_leaf_age_for_senescence_tab(j)
+
+       ! consistency check
+
+       IF ( ( ( pheno_crit%senescence_type(j) .EQ. 'dry' ) .OR. &
+            ( pheno_crit%senescence_type(j) .EQ. 'mixed' )     ) .AND. &
+            ( pheno_crit%nosenescence_hum(j) .EQ. undef )                   ) THEN
+          STOP 'problem with senescence parameters, humidity. (::pheno_crit%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.
+       !
+
+       pheno_crit%leaffall(j) = leaffall_tab(j)
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       length of leaf death (d): (::pheno_crit%leaffall(j))', pheno_crit%leaffall(j)
+
+       !
+       ! 15 maximum lifetime of leaves (days)
+       !
+
+       pheno_crit%leafagecrit(j) = leafagecrit_tab(j)
+
+       IF ( ( bavard .GE. 1 ) .AND. ( pheno_crit%leafagecrit(j) .NE. undef ) ) &
+            WRITE(numout,*) '       critical leaf age (d): (::pheno_crit%leafagecrit(j))', pheno_crit%leafagecrit(j)
+
+       !
+       ! 16 time constant for leaf age discretisation (days)
+       !
+
+       leaf_timecst(j) = pheno_crit%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 ( tree(j) ) THEN
+          pheno_crit%lai_initmin(j) = 0.3
+       ELSE
+          pheno_crit%lai_initmin(j) = 0.1
+       ENDIF !( tree(j) )
+
+       IF ( bavard .GE. 1 ) &
+            WRITE(numout,*) '       initial LAI: (::pheno_crit%lai_initmin(j))', pheno_crit%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
+       !
+
+       coeff_maint_zero(j,ileaf) = cm_zero_leaf_tab(j)
+       coeff_maint_zero(j,isapabove) = cm_zero_sapabove_tab(j)
+       coeff_maint_zero(j,isapbelow) = cm_zero_sapbelow_tab(j)
+       coeff_maint_zero(j,iheartabove) = cm_zero_heartabove_tab(j)
+       coeff_maint_zero(j,iheartbelow) = cm_zero_heartbelow_tab(j)
+       coeff_maint_zero(j,iroot) = cm_zero_root_tab(j)
+       coeff_maint_zero(j,ifruit) = cm_zero_fruit_tab(j)
+       coeff_maint_zero(j,icarbres) = cm_zero_carbres_tab(j)
+
+       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
+       !
+
+       maint_resp_slope(j,1) = maint_resp_slope1_tab(j)
+       maint_resp_slope(j,2) = maint_resp_slope2_tab(j)
+       maint_resp_slope(j,3) = maint_resp_slope3_tab(j)
+
+       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
+       !
+
+       t_photo%t_min_a(j) = tphoto_min_a_tab(j)
+       t_photo%t_min_b(j) = tphoto_min_b_tab(j)
+       t_photo%t_min_c(j) = tphoto_min_c_tab(j)
+       t_photo%t_opt_a(j) = tphoto_opt_a_tab(j)
+       t_photo%t_opt_b(j) = tphoto_opt_b_tab(j)
+       t_photo%t_opt_c(j) = tphoto_opt_c_tab(j)
+       t_photo%t_max_a(j) = tphoto_max_a_tab(j)
+       t_photo%t_max_b(j) = tphoto_max_b_tab(j)
+       t_photo%t_max_c(j) = tphoto_max_c_tab(j)
+
+       IF ( bavard .GE. 1 ) THEN
+          WRITE(numout,*) '       min. temperature for photosynthesis as a function of long term T (C):'
+          WRITE(numout,*) '       (::t_photo%t_min_c)'
+          WRITE(numout,*) '          ',t_photo%t_min_c(j), &
+               ' + T*',t_photo%t_min_b(j), &
+               ' + T^2*',t_photo%t_min_a(j)
+          WRITE(numout,*) '       opt. temperature for photosynthesis as a function of long term T (C):' 
+          WRITE(numout,*) '       (::t_photo%t_opt_c)'
+          WRITE(numout,*) '          ',t_photo%t_opt_c(j), &
+               ' + T*',t_photo%t_opt_b(j), &
+               ' + T^2*',t_photo%t_opt_a(j)
+          WRITE(numout,*) '       max. temperature for photosynthesis as a function of long term T (C):' 
+          WRITE(numout,*)'        (::t_photo%t_max_c)'
+          WRITE(numout,*) '          ',t_photo%t_max_c(j), &
+               ' + T*',t_photo%t_max_b(j), &
+               ' + T^2*',t_photo%t_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 
+       !
+       ! There exists two parameters in ORCHIDEE which design the extinction coefficient:
+       ! ext_coef and ext_coeff. ext_coef is used by SECHIBA and ext_coeff (the same parameter) is used by STOMATE.
+       ! ext_coeff for STOMATE is initialized by ext_coef.
+
+       ext_coeff(j) = ext_coef(j)
+
+       IF ( bavard .GE. 1 ) THEN
+          WRITE(numout,*) '       extinction coefficient: (::ext_coeff(j))', ext_coeff(j)
+       ENDIF !( bavard .GE. 1 )
+
+       !
+       ! 28 check coherence between tree definitions
+       !      this is not absolutely necessary (just security)
+       !
+
+       IF ( tree(j) .NEQV. is_tree(j) ) THEN
+          STOP 'Definition of tree/not tree not coherent (::tree)'
+       ENDIF
+
+    ENDDO ! Loop over # PFTS 
+
+    !
+    ! 29 time scales for phenology and other processes (in days)
+    !
+
+    pheno_crit%tau_hum_month = 20.            ! (!)
+
+    pheno_crit%tau_hum_week = 7.
+
+    pheno_crit%tau_t2m_month = 20.            ! (!)
+
+    pheno_crit%tau_t2m_week = 7.
+
+    pheno_crit%tau_tsoil_month = 20.          ! (!)
+
+    pheno_crit%tau_soilhum_month = 20.        ! (!)
+
+    pheno_crit%tau_gpp_week = 7.
+
+    pheno_crit%tau_gdd = 40.
+
+    pheno_crit%tau_ngd = 50.
+
+    pheno_crit%tau_longterm = 3. * one_year
+
+    IF ( bavard .GE. 1 ) THEN
+
+       WRITE(numout,*) '   > time scale for ''monthly'' moisture availability (d): (::pheno_crit%tau_hum_month)', &
+            pheno_crit%tau_hum_month
+       WRITE(numout,*) '   > time scale for ''weekly'' moisture availability (d): (::pheno_crit%tau_hum_week)', &
+            pheno_crit%tau_hum_week
+       WRITE(numout,*) '   > time scale for ''monthly'' 2 meter temperature (d): (::pheno_crit%tau_t2m_month)', &
+            pheno_crit%tau_t2m_month
+       WRITE(numout,*) '   > time scale for ''weekly'' 2 meter temperature (d): (::pheno_crit%tau_t2m_week)', &
+            pheno_crit%tau_t2m_week
+       WRITE(numout,*) '   > time scale for ''weekly'' GPP (d): (::pheno_crit%tau_gpp_week)', &
+            pheno_crit%tau_gpp_week
+       WRITE(numout,*) '   > time scale for ''monthly'' soil temperature (d): (::pheno_crit%tau_tsoil_month)', &
+            pheno_crit%tau_tsoil_month
+       WRITE(numout,*) '   > time scale for ''monthly'' soil humidity (d): (::pheno_crit%tau_soilhum_month)', &
+            pheno_crit%tau_soilhum_month
+       WRITE(numout,*) '   > time scale for vigour calculations (y): (::pheno_crit%tau_longterm / one_year)', &
+            pheno_crit%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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_io.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_io.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_io.f90	(revision 854)
@@ -0,0 +1,2024 @@
+!< $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 ioipsl
+  USE stomate_constants
+  USE constantes_veg
+  USE parallel
+  !-
+  IMPLICIT NONE
+  !-
+  PRIVATE
+  PUBLIC readstart, writerestart, readbc,get_reftemp_clear
+  !-
+  ! first call?
+  !-
+  LOGICAL,SAVE :: firstcall = .TRUE.
+  !-
+  ! reference temperature (K)
+  !-
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE :: trefe
+  !-
+CONTAINS
+  !-
+  !===
+  !-
+  SUBROUTINE readstart &
+       & (npts, index, lalo, resolution, day_counter, dt_days, date, &
+       &  ind, adapted, regenerate, moiavail_daily, 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_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_lowgpp, time_hum_min, hum_min_dormance, &
+       &  litterpart, litter, dead_leaves, &
+       &  carbon, black_carbon, lignin_struc,turnover_time, &
+       &  prod10,prod100,flux10, flux100, &
+       &  convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total)
+    !---------------------------------------------------------------------
+    !- 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
+    ! 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),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 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),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),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
+    ! duration of dormance (d)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: time_lowgpp
+    ! 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 and below ground (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs),INTENT(out):: litter
+    ! 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),INTENT(out) :: carbon
+    ! 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 and below ground,(gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nlevs),INTENT(out) :: lignin_struc
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: turnover_time
+    !-
+    ! 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
+    ! string suffix indicating level
+    CHARACTER(LEN=2),DIMENSION(nlevs) :: level_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
+
+    ! 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),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
+    !-
+    DO l=1,nlevs
+       IF     (l == iabove) THEN
+          level_str(l) = 'ab'
+       ELSEIF (l == ibelow) THEN
+          level_str(l) = 'be'
+       ELSE
+          STOP 'Define level_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
+    !-
+    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 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))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                .TRUE., turnover_daily(:,:,k), 'gather', nbp_glo, index_g)
+       IF (ALL(turnover_daily(:,:,k) == val_exp)) &
+            &       turnover_daily(:,:,k) = zero
+    ENDDO
+    !-
+    ! 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
+    !-
+    ! 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_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_lowgpp(:,:) = val_exp
+    var_name = 'time_lowgpp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+         &              .TRUE., time_lowgpp, 'gather', nbp_glo, index_g)
+    IF (ALL(time_lowgpp(:,:) == val_exp)) time_lowgpp(:,:) = 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 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))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &              .TRUE., turnover_longterm(:,:,k), 'gather', nbp_glo, index_g)
+       IF (ALL(turnover_longterm(:,:,k) == val_exp)) &
+            &       turnover_longterm(:,:,k) = zero
+    ENDDO
+    !-
+    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 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))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                   .TRUE., biomass(:,:,k), 'gather', nbp_glo, index_g)
+       IF (ALL(biomass(:,:,k) == val_exp)) biomass(:,:,k) = zero
+    ENDDO
+    !-
+    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(:,:) = undef
+    !-
+    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(:,:,:,:) = val_exp
+    DO l=1,nlevs
+       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))//'_'//level_str(l)
+          CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
+               &                     .TRUE., litter(:,:,m,l), 'gather', nbp_glo, index_g)
+          IF (ALL(litter(:,:,m,l) == val_exp)) litter(:,:,m,l) = zero
+       ENDDO
+    ENDDO
+    !-
+    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_'//part_str(1:LEN_TRIM(part_str))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
+            &                   .TRUE., carbon(:,:,m), 'gather', nbp_glo, index_g)
+       IF (ALL(carbon(:,:,m) == val_exp)) carbon(:,:,m) = zero
+    ENDDO
+    !-
+    lignin_struc(:,:,:) = val_exp
+    DO l=1,nlevs
+       var_name = 'lignin_struc_'//level_str(l)
+       CALL restget_p &
+            &    (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &     .TRUE., lignin_struc(:,:,l), 'gather', nbp_glo, index_g)
+       IF (ALL(lignin_struc(:,:,l) == val_exp)) lignin_struc(:,:,l) = zero
+    ENDDO
+    !-
+    ! 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 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))
+       CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm  , 1, itime, &
+            &                .TRUE., bm_to_litter(:,:,k), 'gather', nbp_glo, index_g)
+       IF (ALL(bm_to_litter(:,:,k) == val_exp)) bm_to_litter(:,:,k) = zero
+    ENDDO
+
+    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
+    !-
+
+    IF (bavard >= 4) WRITE(numout,*) 'Leaving readstart'
+    !-----------------------
+  END SUBROUTINE readstart
+  !-
+  !===
+  !-
+  SUBROUTINE writerestart &
+       & (npts, index, day_counter, dt_days, date, &
+       &  ind, adapted, regenerate, moiavail_daily, 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_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_lowgpp, time_hum_min, hum_min_dormance, &
+       &  litterpart, litter, dead_leaves, &
+       &  carbon, black_carbon, lignin_struc, turnover_time, &
+       &  prod10,prod100 ,flux10, flux100, &
+       &  convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total)
+
+    !---------------------------------------------------------------------
+    !- 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
+    ! 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),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 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),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),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
+    ! duration of dormance (d)
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: time_lowgpp
+    ! 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 and below ground (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs),INTENT(in) :: litter
+    ! 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),INTENT(in) :: carbon
+    ! 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 and below ground, (gC/m**2)
+    REAL(r_std),DIMENSION(npts,nvm,nlevs),INTENT(in) :: lignin_struc
+    ! turnover_time of leaves
+    REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: turnover_time
+    !-
+    ! 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
+    ! string suffix indicating level
+    CHARACTER(LEN=2),DIMENSION(nlevs) :: level_str
+    ! temporary storage
+    REAL(r_std),DIMENSION(1) :: xtmp
+    ! index
+    INTEGER(i_std) :: j,k,l,m
+
+    ! 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),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,nlevs
+       IF     (l == iabove) THEN
+          level_str(l) = 'ab'
+       ELSEIF (l == ibelow) THEN
+          level_str(l) = 'be'
+       ELSE
+          STOP 'Define level_str'
+       ENDIF
+    ENDDO
+    !-
+    IF (is_root_prc) THEN
+       CALL ioconf_setatt ('UNITS','-')
+       CALL ioconf_setatt ('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 = '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 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))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                   turnover_daily(:,:,k), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    ! 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_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_lowgpp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+         &                time_lowgpp, '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 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))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                   turnover_longterm(:,:,k), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    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 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))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                   biomass(:,:,k), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    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 l=1,nlevs
+       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))//'_'//level_str(l)
+          CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
+               &                     litter(:,:,m,l), 'scatter', nbp_glo, index_g)
+       ENDDO
+    ENDDO
+    !-
+    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_'//part_str(1:LEN_TRIM(part_str))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
+            &                   carbon(:,:,m), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    DO l=1,nlevs
+       var_name = 'lignin_struc_'//level_str(l)
+       CALL restput_p &
+            &      (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &       lignin_struc(:,:,l), 'scatter', nbp_glo, index_g)
+    ENDDO
+    !-
+    ! 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 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))
+       CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
+            &                bm_to_litter(:,:,k), 'scatter', nbp_glo, index_g)
+    ENDDO
+    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)
+    !-
+    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) :: m_pi
+    REAL(r_std) :: resx, resy
+    LOGICAL :: do_again
+    !---------------------------------------------------------------------
+    m_pi = 4. * ATAN(1.)
+    !-
+    ! 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
+       !Config        temperature is read
+       !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)
+       !---
+       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)*m_pi/180.),0.001)*m_pi/180.*R_Earth
+             !-------
+             lon_up  = lalo(ib,2)+resx/(2.0*coslat)
+             lon_low = lalo(ib,2)-resx/(2.0*coslat)
+             !-------
+             coslat  = m_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)*m_pi/180.),0.001)
+                            ax =  ( MIN(lon_up,loup_rel(ip,jp)) &
+                                 &                       -MAX(lon_low,lolow_rel(ip,jp))) &
+                                 &                     *m_pi/180.*R_Earth*coslat
+                            ay =  ( MIN(lat_up,laup_rel(ip,jp)) &
+                                 &                       -MAX(lat_low,lalow_rel(ip,jp))) &
+                                 &                     *m_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.*m_pi*R_Earth .OR. resy > m_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.*m_pi*R_Earth .OR. resy > m_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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_lcchange.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_lcchange.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_lcchange.f90	(revision 854)
@@ -0,0 +1,347 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE stomate_data
+  USE constantes_veg
+  
+  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, veget,&        
+       co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, tree, cn_ind,flux10,flux100, &
+       prod10,prod100,&
+       convflux,&
+       cflux_prod10,cflux_prod100, leaf_frac,&
+       npp_longterm, lm_lastyearmax, litter, carbon)
+    
+    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(npts,nvm), INTENT(INOUT)           :: veget_max_new    !! new "maximal" coverage fraction of a PFT (LAI
+                                                                                  !! -> infinity) on ground
+    REAL(r_std) , DIMENSION (nvm, nparts), INTENT(in)         :: bm_sapl          !! biomass of sapling 
+                                                                                  !! @tex ($gC individual^{-1}$) @endtex
+    LOGICAL, DIMENSION(nvm), INTENT(in)                       :: tree             !! Does the pft contains trees?
+
+    !! 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), INTENT(out)      :: turnover_daily   !! Turnover rates 
+                                                                                  !! @tex ($gC m^{-2} day^{-1}$) @endtex
+
+    !! 0.3 Modified variables   
+    
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)           :: veget            !! fractional coverage on natural/agricultural 
+                                                                                  !! ground (unitless)
+    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), 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), 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,nlevs), INTENT(inout):: litter           !! metabolic and structural litter, above and 
+                                                                                  !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,ncarb,nvm), INTENT(inout)      :: carbon           !! carbon pool: active, slow, or passive 
+                                                                                  !! @tex ($gC m^{-2}$) @endtex
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                            :: i, j, k, l, m    !! indices (unitless)
+    REAL(r_std)                                               :: bm_new           !! biomass increase @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,nparts)                        :: 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,nlevs)                   :: dilu_lit         !! Litter dilution @tex ($gC m^{-2}$) @endtex
+    REAL(r_std),DIMENSION(npts,ncarb)                         :: 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  
+!_ ================================================================================================================================
+
+    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
+    
+  !! 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(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(i,:,:) = dilu_lit(i,:,:) + delta_veg(j)*litter(i,:,j,:) / delta_veg_sum
+             dilu_soil_carbon(i,:) =  dilu_soil_carbon(i,:) + delta_veg(j) * carbon(i,:,j) / delta_veg_sum
+             biomass_loss(i,:) = biomass_loss(i,:) + biomass(i,j,:)*delta_veg(j) / delta_veg_sum
+          ENDIF
+       ENDDO
+       
+       !! 2.3 
+       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 (tree(j)) THEN
+
+                   ! cn_sapl(j)=0.5; stomate_data.f90
+                   cn_ind(i,j) = cn_sapl(j) 
+                ELSE
+                   cn_ind(i,j)=1.0
+                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) = 0.
+
+                ! large_value = 1.E33_r_std
+                when_growthinit(i,j) = large_value 
+                leaf_frac(i,j,1) = 1.0
+                npp_longterm(i,j) = 10.
+                lm_lastyearmax(i,j) = bm_sapl(j,ileaf) * 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 
+                bm_new = delta_ind(i,j) * bm_sapl(j,k) 
+                IF (veget_max(i,j) .GT. min_stomate) THEN
+
+                   ! in the case that bm_new is overestimated compared with biomass?
+                   IF ((bm_new/delta_veg(j)) > biomass(i,j,k)) THEN
+                      bm_new = biomass(i,j,k)*delta_veg(j)
+                   ENDIF
+                ENDIF
+                biomass(i,j,k) = ( biomass(i,j,k) * veget_max(i,j) + bm_new )  / veget_max_new(i,j)
+                co2_to_bm(i,j) = co2_to_bm(i,j)+  (bm_new* dt_days) / (one_year * veget_max_new(i,j))
+             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(i,:,j,:)=(litter(i,:,j,:) * veget_max(i,j) + &
+                  dilu_lit(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)
+
+             ! Litter input
+             bm_to_litter(i,j,isapbelow) = bm_to_litter(i,j,isapbelow) + &
+                  &                         biomass_loss(i,isapbelow)*delta_veg(j) / veget_max_new(i,j)
+             bm_to_litter(i,j,iheartbelow) = bm_to_litter(i,j,iheartbelow) + biomass_loss(i,iheartbelow) *delta_veg(j) &
+                  &  / veget_max_new(i,j)
+             bm_to_litter(i,j,iroot) = bm_to_litter(i,j,iroot) + biomass_loss(i,iroot)*delta_veg(j) / veget_max_new(i,j)
+             bm_to_litter(i,j,ifruit) = bm_to_litter(i,j,ifruit) + biomass_loss(i,ifruit)*delta_veg(j) / veget_max_new(i,j)
+             bm_to_litter(i,j,icarbres) = bm_to_litter(i,j,icarbres) + &
+                  &                         biomass_loss(i,icarbres)   *delta_veg(j) / veget_max_new(i,j)
+             bm_to_litter(i,j,ileaf) = bm_to_litter(i,j,ileaf) + biomass_loss(i,ileaf)*delta_veg(j) / veget_max_new(i,j)
+             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) + biomass(i,j,iheartabove)
+             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(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
+       
+       !! 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) = 0.0
+       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) = 0.0
+       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)        = 0.0
+       prod100(i,0)       = 0.0 
+       
+    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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_litter.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_litter.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_litter.f90	(revision 854)
@@ -0,0 +1,879 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC littercalc,littercalc_clear, deadleaf
+
+  LOGICAL, SAVE                        :: firstcall = .TRUE.       !! first call
+
+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)
+!! \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, 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, 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, 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 6 the dead leaf cover is calculated through a call to the 
+!! deadleaf subroutine presented below.\n
+!!
+!! MAIN OUTPUT VARIABLES: ::deadleaf_cover, ::resp_hetero_litter, ::soilcarbon_input, 
+!! ::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.
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics(scale=0.5){littercalcflow.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE littercalc (npts, dt, &
+       turnover, bm_to_litter, &
+       veget_max, tsurf, tsoil, soilhum, litterhum, &
+       litterpart, litter, dead_leaves, lignin_struc, &
+       deadleaf_cover, resp_hetero_litter, &
+       soilcarbon_input, control_temp, control_moist)
+  
+    !! 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), INTENT(in)         :: turnover           !! Turnover rates of plant biomass 
+                                                                                      !! @tex $(gC m^{-2} dt\_slow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), 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)
+
+    !! 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,ncarb,nvm), INTENT(out)         :: soilcarbon_input   !! Quantity of carbon going into carbon pools
+                                                                                      !! from litter decomposition. The unit is  
+                                                                                      !! given by m^2 of ground 
+                                                                                      !! @tex $(gC m^{-2} dt\_slow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nlevs), INTENT(out)             :: control_temp       !! Temperature control of heterotrophic 
+                                                                                      !! respiration, above and below (0-1, 
+                                                                                      !! unitless)
+    REAL(r_std), DIMENSION(npts,nlevs), INTENT(out)             :: control_moist      !! Moisture control of heterotrophic 
+                                                                                      !! respiration (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,nlevs), INTENT(inout) :: litter             !! Metabolic and structural litter,above and
+                                                                                      !! 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,nlevs), INTENT(inout)       :: lignin_struc       !! Ratio Lignin content in structural litter,
+                                                                                      !! above and below ground, (0-1, unitless)
+    
+    !! 0.4 Local variables
+ 
+    REAL(r_std), SAVE, DIMENSION(nparts)                        :: CN                 !! C/N ratio of each plant carbon pool
+    REAL(r_std), SAVE, DIMENSION(nparts,nlitt)                  :: litterfrac         !! The fraction of leaves, wood, etc. that 
+                                                                                      !! goes into metabolic and structural 
+                                                                                      !! litterpools (0-1, unitless)
+    REAL(r_std), SAVE, DIMENSION(nparts)                        :: LC                 !! Lignin/C ratio of different plant parts 
+                                                                                      !! ([0.22;0.35], unitless)
+    REAL(r_std), SAVE, DIMENSION(0:nbdl)                        :: z_soil             !! Soil levels (m)
+    REAL(r_std), PARAMETER                                      :: z_decomp = 0.2     !! Maximum depth for soil decomposer's 
+                                                                                      !! activity (m)
+    REAL(r_std), DIMENSION(npts)                                :: rpc                !! Integration constant for vertical root 
+                                                                                      !! profiles (unitless)
+    REAL(r_std), SAVE, DIMENSION(nlitt)                         :: litter_tau         !! Turnover time in litter pools (days)
+    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
+    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), DIMENSION(npts)                                :: fd                 !! Fraction of structural or metabolic litter
+                                                                                      !! decomposed (unitless)
+    REAL(r_std), DIMENSION(npts)                                :: qd                 !! Quantity of structural or metabolic litter
+                                                                                      !! decomposed @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlevs)                      :: old_struc          !! Old structural litter, above and below 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nlevs)                :: litter_inc_PFT     !! Increase of litter, per PFT, metabolic and
+                                                                                      !! structural, above and below ground. The 
+                                                                                      !! unit is given by m^2 of ground.  
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs)                :: litter_inc         !! Increase of metabolic and structural 
+                                                                                      !! litter, above and below ground. The unit 
+                                                                                      !! is given by m^2 of ground. 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlevs)                      :: lignin_struc_inc   !! Lignin increase in structural litter, 
+                                                                                      !! above and below ground. The unit is given 
+                                                                                      !! by m^2 of ground. 
+                                                                                      !! @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nlitt)                      :: 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*10, DIMENSION(nlitt)                              :: litter_str         !! Messages to write output information about
+                                                                                      !! the litter
+    CHARACTER*22, DIMENSION(nparts)                             :: part_str           !! Messages to write output information about
+                                                                                      !! the plant
+    CHARACTER*7, DIMENSION(ncarb)                               :: carbon_str         !! Messages to write output information about
+                                                                                      !! the soil carbon
+    CHARACTER*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)
+!_ ================================================================================================================================
+
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering littercalc'
+
+  !! 1. Initialisations of the different fields during the first call of the routine 
+
+    IF ( firstcall ) THEN
+
+       
+       !! 1.1 get soil "constants"
+
+       !! 1.1.1 C/N ratios
+       CN(ileaf) = 40.0
+       CN(isapabove) = 40.0
+       CN(isapbelow) = 40.0
+       CN(iheartabove) = 40.0
+       CN(iheartbelow) = 40.0
+       CN(iroot) = 40.0
+       CN(ifruit) = 40.0
+       CN(icarbres) = 40.0
+
+       !! 1.1.2 Lignine/C ratios
+       LC(ileaf) = 0.22
+       LC(isapabove) = 0.35
+       LC(isapbelow) = 0.35
+       LC(iheartabove) = 0.35
+       LC(iheartbelow) = 0.35
+       LC(iroot) = 0.22
+       LC(ifruit) = 0.22
+       LC(icarbres) = 0.22
+
+       !! 1.1.3 litter fractions:
+       !!   what fraction of leaves, wood, etc. goes into metabolic and structural litterpools
+       DO k = 1, nparts
+
+          litterfrac(k,imetabolic) = 0.85 - 0.018 * LC(k) * CN(k)
+          litterfrac(k,istructural) = un - litterfrac(k,imetabolic)
+
+       ENDDO
+
+       !! 1.1.4 residence times in litter pools (days)
+       litter_tau(imetabolic) = .066 * one_year      ! .5 years
+       litter_tau(istructural) = .245 * one_year     ! 3 years
+
+       !! 1.1.5 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) = .55
+       frac_soil(istructural,iactive,ibelow) = .45
+       frac_soil(istructural,islow,iabove) = .7
+       frac_soil(istructural,islow,ibelow) = .7
+
+       ! metabolic litter: all goes into active pool + respiration.
+       !   Nothing into slow or passive pool.
+       frac_soil(imetabolic,iactive,iabove) = .45
+       frac_soil(imetabolic,iactive,ibelow) = .45
+
+       
+       !! 1.2 soil levels
+       z_soil(0) = zero
+       z_soil(1:nbdl) = diaglev(1:nbdl)
+
+       
+       !! 1.3 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,*) '   > scaling depth for decomposition (m): ',z_decomp
+
+       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 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) = litterpart(:,j,k) * litter(:,k,j,iabove)
+       ENDDO
+
+    ENDDO
+
+    
+    !! 1.4 set output to zero
+    deadleaf_cover(:) = zero
+    resp_hetero_litter(:,:) = zero
+    soilcarbon_input(:,:,:) = zero
+
+    
+  !! 2. Add biomass to different litterpools (per m^2 of ground)
+    
+    !! 2.1 first, save old structural litter (needed for lignin fractions).
+    !     above/below
+    DO l = 1, nlevs !Loop over litter levels (above and below ground)
+       DO m = 2,nvm !Loop over PFTs
+
+          old_struc(:,m,l) = litter(:,istructural,m,l)
+
+       ENDDO
+    ENDDO
+
+    
+    !! 2.2 update litter, dead leaves, and lignin content in structural litter
+    litter_inc(:,:,:,:) = zero
+    lignin_struc_inc(:,:,:) = 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
+               litter_inc_PFT(:,j,k,iabove) = &
+               litterfrac(ileaf,k) * bm_to_litter(:,j,ileaf) + &
+               litterfrac(isapabove,k) * bm_to_litter(:,j,isapabove) + &
+               litterfrac(iheartabove,k) * bm_to_litter(:,j,iheartabove) + &
+               litterfrac(ifruit,k) * bm_to_litter(:,j,ifruit) + &
+               litterfrac(icarbres,k) * bm_to_litter(:,j,icarbres) + &
+               litterfrac(ileaf,k) * turnover(:,j,ileaf) + &
+               litterfrac(isapabove,k) * turnover(:,j,isapabove) + &
+               litterfrac(iheartabove,k) * turnover(:,j,iheartabove) + &
+               litterfrac(ifruit,k) * turnover(:,j,ifruit) + &
+               litterfrac(icarbres,k) * turnover(:,j,icarbres)
+
+               litter_inc_PFT(:,j,k,ibelow) = &
+               litterfrac(isapbelow,k) * bm_to_litter(:,j,isapbelow) + &
+               litterfrac(iheartbelow,k) * bm_to_litter(:,j,iheartbelow) + &
+               litterfrac(iroot,k) * bm_to_litter(:,j,iroot) + &
+               litterfrac(isapbelow,k) * turnover(:,j,isapbelow) + &
+               litterfrac(iheartbelow,k) * turnover(:,j,iheartbelow) + &
+               litterfrac(iroot,k) * turnover(:,j,iroot)
+
+          ! litter increase, met/struct, above/below
+              litter_inc(:,k,j,iabove) = litter_inc(:,k,j,iabove) + litter_inc_PFT(:,j,k,iabove)
+              litter_inc(:,k,j,ibelow) = litter_inc(:,k,j,ibelow) + litter_inc_PFT(:,j,k,ibelow)
+
+          !! 2.2.3 dead leaves, for soil cover.
+               dead_leaves(:,j,k) = &
+               dead_leaves(:,j,k) + &
+               litterfrac(ileaf,k) * ( bm_to_litter(:,j,ileaf) + turnover(:,j,ileaf) )
+
+          !! 2.2.4 lignin increase in structural litter
+          IF ( k .EQ. istructural ) THEN
+
+             lignin_struc_inc(:,j,iabove) = &
+                  lignin_struc_inc(:,j,iabove) + &
+                  LC(ileaf) * bm_to_litter(:,j,ileaf) + &
+                  LC(isapabove) * bm_to_litter(:,j,isapabove) + &
+                  LC(iheartabove) * bm_to_litter(:,j,iheartabove) + &
+                  LC(ifruit) * bm_to_litter(:,j,ifruit) + &
+                  LC(icarbres) * bm_to_litter(:,j,icarbres) + &
+                  LC(ileaf) * turnover(:,j,ileaf) + &
+                  LC(isapabove) * turnover(:,j,isapabove) + &
+                  LC(iheartabove) * turnover(:,j,iheartabove) + &
+                  LC(ifruit) * turnover(:,j,ifruit) + &
+                  LC(icarbres) * turnover(:,j,icarbres)
+
+                  lignin_struc_inc(:,j,ibelow) = &
+                  lignin_struc_inc(:,j,ibelow) + &
+                  LC(isapbelow) * bm_to_litter(:,j,isapbelow) + &
+                  LC(iheartbelow) * bm_to_litter(:,j,iheartbelow) + &
+                  LC(iroot) * bm_to_litter(:,j,iroot) + &
+                  LC(isapbelow)*turnover(:,j,isapbelow) + &
+                  LC(iheartbelow)*turnover(:,j,iheartbelow) + &
+                  LC(iroot)*turnover(:,j,iroot)
+
+          ENDIF
+
+       ENDDO
+    ENDDO
+
+    !! 2.2.5 add new litter (struct/met, above/below)
+    litter(:,:,:,:) = litter(:,:,:,:) + litter_inc(:,:,:,:)
+
+    !! 2.2.6 for security: can't add more lignin than structural litter (above/below)
+    DO l = 1, nlevs !Loop over litter levels (above and below ground)
+       DO m = 2,nvm !Lopp over PFTs
+
+          lignin_struc_inc(:,m,l) = &
+               MIN( lignin_struc_inc(:,m,l), litter_inc(:,istructural,m,l) )
+
+       ENDDO
+    ENDDO
+
+    !! 2.2.7 new lignin content: add old lignin and lignin increase, divide by 
+    !!       total structural litter (above/below)
+    DO l = 1, nlevs !Loop over litter levels (above and below ground)
+       DO m = 2,nvm !Loop over PFTs
+          WHERE( litter(:,istructural,m,l) .GT. min_stomate )
+
+       !MM : Soenke modif
+       ! Best vectorization ?
+!!$       lignin_struc(:,:,:) = &
+!!$            ( lignin_struc(:,:,:)*old_struc(:,:,:) + lignin_struc_inc(:,:,:) ) / &
+!!$            litter(:,istructural,:,:,icarbon)
+
+             lignin_struc(:,m,l) = lignin_struc(:,m,l) * old_struc(:,m,l)
+             lignin_struc(:,m,l) = lignin_struc(:,m,l) + lignin_struc_inc(:,m,l)
+             lignin_struc(:,m,l) = lignin_struc(:,m,l) / litter(:,istructural,m,l)
+          ELSEWHERE
+             lignin_struc(:,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
+
+       WHERE ( litter(:,:,j,iabove) .GT. min_stomate )
+
+          litterpart(:,j,:) = &
+               ( litter_pft(:,j,:) + litter_inc_PFT(:,j,:,iabove) ) / litter(:,:,j,iabove)
+
+       ELSEWHERE
+
+          litterpart(:,j,:) = zero
+
+       ENDWHERE
+
+    ENDDO
+
+    
+  !! 3. Temperature control on decay: Factor between 0 and 1
+
+    !! 3.1 above: surface temperature
+    control_temp(:,iabove) = control_temp_func (npts, tsurf)
+
+    
+    !! 3.2 below: convolution of temperature and decomposer profiles
+    !!            (exponential decomposer profile supposed)
+   
+    !! 3.2.1 rpc is an integration constant such that the integral of the root profile is 1.
+    rpc(:) = un / ( un - EXP( -z_soil(nbdl) / z_decomp ) )
+
+    !! 3.2.2 integrate over the nbdl levels
+    tsoil_decomp(:) = 0.0
+
+    DO l = 1, nbdl
+
+       tsoil_decomp(:) = &
+            tsoil_decomp(:) + tsoil(:,l) * rpc(:) * &
+            ( EXP( -z_soil(l-1)/z_decomp ) - EXP( -z_soil(l)/z_decomp ) )
+
+    ENDDO
+
+    control_temp(:,ibelow) = control_temp_func (npts, tsoil_decomp)
+
+  !! 4. Moisture control. Factor between 0 and 1
+    
+    !! 4.1 above the ground: litter humidity
+    control_moist(:,iabove) = control_moist_func (npts, litterhum)
+
+    !
+    !! 4.2 below: convolution of humidity and decomposer profiles
+    !            (exponential decomposer profile supposed)
+
+    !! 4.2.1 rpc is an integration constant such that the integral of the root profile is 1.
+    rpc(:) = un / ( un - EXP( -z_soil(nbdl) / z_decomp ) )
+
+    !! 4.2.2 integrate over the nbdl levels
+    soilhum_decomp(:) = 0.0
+
+    DO l = 1, nbdl !Loop over soil levels
+
+       soilhum_decomp(:) = &
+            soilhum_decomp(:) + soilhum(:,l) * rpc(:) * &
+            ( EXP( -z_soil(l-1)/z_decomp ) - EXP( -z_soil(l)/z_decomp ) )
+
+    ENDDO
+
+    control_moist(:,ibelow) = control_moist_func (npts, soilhum_decomp)
+
+  !! 5. fluxes from litter to carbon pools and respiration
+
+    DO l = 1, nlevs !Loop over litter levels (above and below ground)
+       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 structural litter which is decomposed
+          fd(:) = dt/litter_tau(istructural) * &
+               control_temp(:,l) * control_moist(:,l) * exp( -3. * lignin_struc(:,m,l) )
+
+          qd(:) = litter(:,istructural,m,l) * fd(:)
+
+          litter(:,istructural,m,l) = litter(:,istructural,m,l) - qd(:)
+
+          !! 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.
+          ! to avoid a multiple (for ibelow and iabove) modification of dead_leaves,
+          ! we do this test to do this calcul only ones in 1,nlev loop
+          if (l == iabove)  dead_leaves(:,m,istructural) = dead_leaves(:,m,istructural) * ( un - fd(:) )
+
+          !! 5.1.3 non-lignin fraction of structural litter goes into
+          !!       active carbon pool + respiration
+          soilcarbon_input(:,iactive,m) = soilcarbon_input(:,iactive,m) + &
+               frac_soil(istructural,iactive,l) * qd(:) * ( 1. - lignin_struc(:,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,iactive,l) ) * qd(:) * &
+               ( 1. - lignin_struc(:,m,l) ) / dt
+
+          !! 5.1.4 lignin fraction of structural litter goes into
+          !!       slow carbon pool + respiration
+          soilcarbon_input(:,islow,m) = soilcarbon_input(:,islow,m) + &
+               frac_soil(istructural,islow,l) * qd(:) * lignin_struc(:,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,l) ) * qd(:) * lignin_struc(:,m,l) / dt
+
+          
+          !! 5.2 metabolic litter goes into active carbon pool + respiration
+         
+          !! 5.2.1 total quantity of metabolic litter that is decomposed
+          fd(:) = dt/litter_tau(imetabolic) * control_temp(:,l) * control_moist(:,l)
+
+          qd(:) = litter(:,imetabolic,m,l) * fd(:)
+
+          litter(:,imetabolic,m,l) = litter(:,imetabolic,m,l) - qd(:)
+
+          !! 5.2.2 decompose same fraction of metabolic part of dead leaves.
+          !  to avoid a multiple (for ibelow and iabove) modification of dead_leaves,
+          !  we do this test to do this calcul only ones in 1,nlev loop
+          if (l == iabove)  dead_leaves(:,m,imetabolic) = dead_leaves(:,m,imetabolic) * ( 1. - fd(:) )
+
+
+          !! 5.2.3 put decomposed litter into carbon pool + respiration
+          soilcarbon_input(:,iactive,m) = soilcarbon_input(:,iactive,m) + &
+               frac_soil(imetabolic,iactive,l) * qd(:) / 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(imetabolic,iactive,l) ) * qd(:) / dt
+
+       ENDDO
+    ENDDO
+
+    
+  !! 6. calculate fraction of total soil covered by dead leaves
+
+    CALL deadleaf (npts, veget_max, dead_leaves, deadleaf_cover)
+
+    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(:) = 1. - exp( - 0.5 * dead_lai(:) )
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving deadleaf'
+
+  END SUBROUTINE deadleaf
+
+
+!! ================================================================================================================================
+!! 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.25-1, unitless)
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+!_ ================================================================================================================================
+
+    moistfunc_result(:) = -1.1 * moist_in(:) * moist_in(:) + 2.4 * moist_in(:) - 0.29
+    moistfunc_result(:) = MAX( 0.25_r_std, MIN( 1._r_std, 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) 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)
+
+    !! 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
+
+!_ ================================================================================================================================
+
+    tempfunc_result(:) = exp( 0.69 * ( temp_in(:) - (ZeroCelsius+30.) ) / 10. )
+    tempfunc_result(:) = MIN( 1._r_std, tempfunc_result(:) )
+
+  END FUNCTION control_temp_func
+
+END MODULE stomate_litter
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_lpj.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_lpj.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_lpj.f90	(revision 854)
@@ -0,0 +1,1142 @@
+! ================================================================================================================================
+! 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
+!!
+!! SVN          :
+!! $HeadURL$
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_lpj
+
+  ! modules used:
+
+  USE ioipsl
+  USE grid
+  USE stomate_constants
+  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 constantes_veg
+  USE stomate_lcchange
+  !  USE Write_Field_p
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC StomateLpj,StomateLpj_clear
+
+  LOGICAL, SAVE                         :: firstcall = .TRUE.             !! first call
+
+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_midwinter, ncd_dormance, ngd_minus5, &
+       turnover_longterm, gpp_daily, time_lowgpp, &
+       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, dead_leaves, carbon, black_carbon, lignin_struc, &
+       veget_max, veget, npp_longterm, lm_lastyearmax, veget_lastlight, &
+       everywhere, need_adjacent, RIP_time, &
+       lai, rprof,npp_daily, turnover_daily, turnover_time,&
+       control_moist, control_temp, 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)
+    
+  !! 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(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_lowgpp          !! Duration of dormance (days)
+    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 
+
+  !! 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), 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), 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,nlevs), INTENT(inout)          :: control_moist        !! Moisture control of heterotrophic 
+                                                                                       !! respiration (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,nlevs), INTENT(inout)          :: control_temp         !! Temperature control of heterotrophic 
+                                                                                       !! respiration, above and below 
+                                                                                       !! (0 to 1, unitless) 
+    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(inout)      :: soilcarbon_input     !! Quantity of carbon going into carbon 
+                                                                                       !! pools from litter decomposition  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    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), 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,nlevs), INTENT(inout):: litter               !! 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,ncarb,nvm), INTENT(inout)      :: carbon               !! Carbon pool: active, slow, or passive, 
+                                                                                       !! @tex $(gC m^{-2})$ @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,nlevs), INTENT(inout)      :: lignin_struc         !! Ratio of Lignin/Carbon in structural 
+                                                                                       !! litter, above and below 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)            :: veget                !! Fractional coverage on ground, taking 
+                                                                                       !! into account LAI (=grid-scale fpc) 
+                                                                                       !! (unitless) 
+    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  
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(npts,nvm)                            :: tot_bm_to_litter    !! Total conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: tot_live_biomass    !! Total living biomass  
+                                                                                       !! @tex $(gC m{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts)                     :: bm_alloc            !! Biomass increase, i.e. NPP per plant part 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: tot_turnover        !! Total turnover rate  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: tot_litter_soil_carb!! Total soil and litter carbon  
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: tot_litter_carb     !! Total litter carbon 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm)                            :: 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
+    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,nvm)                            :: histvar             !! History variables
+!_ ================================================================================================================================
+
+    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.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)+biomass(:,:,isapbelow) &
+                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow)) & 
+                  *veget_max(:,:))/ind(:,:)
+          ENDWHERE
+       ELSE
+          WHERE (ind(:,:).GT.min_stomate)
+             woodmass_ind(:,:) = &
+                  (biomass(:,:,isapabove)+biomass(:,:,isapbelow) &
+                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))/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, PFTpresent, everywhere, when_growthinit, &
+         biomass, leaf_frac, ind, cn_ind)
+
+
+  !! 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, 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, 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)+biomass(:,:,isapbelow) &
+                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))*veget_max(:,:))/ind(:,:)
+          ELSEWHERE
+             woodmass_ind(:,:) =(biomass(:,:,isapabove)+biomass(:,:,isapbelow) &
+                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))/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 and time_lowGPP
+    CALL histwrite (hist_id_stomate, 'WHEN_GROWTHINIT', itime, when_growthinit, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'TIME_LOWGPP', itime, time_lowgpp, npts*nvm, horipft_index)
+
+    ! Set and write values for ::PFTpresent
+    WHERE(PFTpresent)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+    CALL histwrite (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 (hist_id_stomate, 'GDD_MIDWINTER', 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 (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_lowgpp, time_hum_min, &
+         biomass, leaf_frac, leaf_age, &
+         when_growthinit, co2_to_bm, lai)
+    
+  !! 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, 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)+biomass(:,:,isapbelow) &
+                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow)) & 
+                  *veget_max(:,:))/ind(:,:)
+          ENDWHERE
+
+       ! For all pixels with individuals
+       ELSE
+          WHERE (ind(:,:).GT.min_stomate)
+             woodmass_ind(:,:) = &
+                  (biomass(:,:,isapabove)+biomass(:,:,isapbelow) &
+                  +biomass(:,:,iheartabove)+biomass(:,:,iheartbelow))/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, &
+         fireindex, firelitter, biomass, ind, &
+         litter, dead_leaves, bm_to_litter, black_carbon, &
+         co2_fire)
+
+    !! 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, 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, 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, &
+         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 ) 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, 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, veget, &
+         lai, litter, carbon, turnover_daily, bm_to_litter)
+
+  !! 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, veget, &
+            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, veget, & 
+               co2_to_bm, bm_to_litter, turnover_daily, bm_sapl, tree, 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, carbon)
+       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) = tot_litter_carb(:,j) + (litter(:,istructural,j,iabove) + &
+            &          litter(:,imetabolic,j,iabove) + &
+            &          litter(:,istructural,j,ibelow) + litter(:,imetabolic,j,ibelow))
+
+       tot_soil_carb(:,j) = tot_soil_carb(:,j) + (carbon(:,iactive,j) + &
+            &          carbon(:,islow,j)+  carbon(:,ipassive,j))
+
+    ENDDO
+    tot_litter_soil_carb = tot_litter_carb + tot_soil_carb
+
+    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(:)
+    carb_mass_total(:)=SUM((tot_live_biomass+tot_litter_carb+tot_soil_carb)*veget_max,dim=2) + &
+         &                 (prod10_total + prod100_total)
+    carb_mass_variation(:)=carb_mass_total(:)+carb_mass_variation(:)
+    
+  !! 17. Write history
+
+    CALL histwrite (hist_id_stomate, 'RESOLUTION_X', itime, &
+         resolution(:,1), npts, hori_index)
+    CALL histwrite (hist_id_stomate, 'RESOLUTION_Y', itime, &
+         resolution(:,2), npts, hori_index)
+    CALL histwrite (hist_id_stomate, 'CONTFRAC', itime, &
+         contfrac(:), npts, hori_index)
+
+    CALL histwrite (hist_id_stomate, 'LITTER_STR_AB', itime, &
+         litter(:,istructural,:,iabove), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'LITTER_MET_AB', itime, &
+         litter(:,imetabolic,:,iabove), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'LITTER_STR_BE', itime, &
+         litter(:,istructural,:,ibelow), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'LITTER_MET_BE', itime, &
+         litter(:,imetabolic,:,ibelow), npts*nvm, horipft_index)
+
+    CALL histwrite (hist_id_stomate, 'DEADLEAF_COVER', itime, &
+         deadleaf_cover, npts, hori_index)
+
+    CALL histwrite (hist_id_stomate, 'TOTAL_SOIL_CARB', itime, &
+         tot_litter_soil_carb, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'CARBON_ACTIVE', itime, &
+         carbon(:,iactive,:), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'CARBON_SLOW', itime, &
+         carbon(:,islow,:), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'CARBON_PASSIVE', itime, &
+         carbon(:,ipassive,:), npts*nvm, horipft_index)
+
+    CALL histwrite (hist_id_stomate, 'T2M_MONTH', itime, &
+         t2m_month, npts, hori_index)
+    CALL histwrite (hist_id_stomate, 'T2M_WEEK', itime, &
+         t2m_week, npts, hori_index)
+
+    CALL histwrite (hist_id_stomate, 'HET_RESP', itime, &
+         resp_hetero(:,:), npts*nvm, horipft_index)
+
+    CALL histwrite (hist_id_stomate, 'BLACK_CARBON', itime, &
+         black_carbon, npts, hori_index)
+
+    CALL histwrite (hist_id_stomate, 'FIREINDEX', itime, &
+         fireindex(:,:), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'LITTERHUM', itime, &
+         litterhum_daily, npts, hori_index)
+    CALL histwrite (hist_id_stomate, 'CO2_FIRE', itime, &
+         co2_fire, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'CO2_TAKEN', itime, &
+         co2_to_bm, npts*nvm, horipft_index)
+    ! land cover change
+    CALL histwrite (hist_id_stomate, 'CONVFLUX', itime, &
+         convflux, npts, hori_index)
+    CALL histwrite (hist_id_stomate, 'CFLUX_PROD10', itime, &
+         cflux_prod10, npts, hori_index)
+    CALL histwrite (hist_id_stomate, 'CFLUX_PROD100', itime, &
+         cflux_prod100, npts, hori_index)
+    CALL histwrite (hist_id_stomate, 'HARVEST_ABOVE', itime, &
+         harvest_above, npts, hori_index)
+
+    CALL histwrite (hist_id_stomate, 'LAI', itime, &
+         lai, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'VEGET', itime, &
+         veget, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'VEGET_MAX', itime, &
+         veget_max, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'NPP', itime, &
+         npp_daily, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'GPP', itime, &
+         gpp_daily, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'IND', itime, &
+         ind, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'CN_IND', itime, &
+         cn_ind, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'WOODMASS_IND', itime, &
+         woodmass_ind, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'TOTAL_M', itime, &
+         tot_live_biomass, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'LEAF_M', itime, &
+         biomass(:,:,ileaf), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'SAP_M_AB', itime, &
+         biomass(:,:,isapabove), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'SAP_M_BE', itime, &
+         biomass(:,:,isapbelow), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'HEART_M_AB', itime, &
+         biomass(:,:,iheartabove), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'HEART_M_BE', itime, &
+         biomass(:,:,iheartbelow), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'ROOT_M', itime, &
+         biomass(:,:,iroot), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'FRUIT_M', itime, &
+         biomass(:,:,ifruit), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'RESERVE_M', itime, &
+         biomass(:,:,icarbres), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'TOTAL_TURN', itime, &
+         tot_turnover, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'LEAF_TURN', itime, &
+         turnover_daily(:,:,ileaf), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'SAP_AB_TURN', itime, &
+         turnover_daily(:,:,isapabove), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'ROOT_TURN', itime, &
+         turnover_daily(:,:,iroot), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'FRUIT_TURN', itime, &
+         turnover_daily(:,:,ifruit), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'TOTAL_BM_LITTER', itime, &
+         tot_bm_to_litter, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'LEAF_BM_LITTER', itime, &
+         bm_to_litter(:,:,ileaf), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'SAP_AB_BM_LITTER', itime, &
+         bm_to_litter(:,:,isapabove), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'SAP_BE_BM_LITTER', itime, &
+         bm_to_litter(:,:,isapbelow), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'HEART_AB_BM_LITTER', itime, &
+         bm_to_litter(:,:,iheartabove), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'HEART_BE_BM_LITTER', itime, &
+         bm_to_litter(:,:,iheartbelow), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'ROOT_BM_LITTER', itime, &
+         bm_to_litter(:,:,iroot), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'FRUIT_BM_LITTER', itime, &
+         bm_to_litter(:,:,ifruit), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'RESERVE_BM_LITTER', itime, &
+         bm_to_litter(:,:,icarbres), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'MAINT_RESP', itime, &
+         resp_maint, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'GROWTH_RESP', itime, &
+         resp_growth, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'AGE', itime, &
+         age, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'HEIGHT', itime, &
+         height, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'MOISTRESS', itime, &
+         moiavail_week, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'VCMAX', itime, &
+         vcmax, npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'TURNOVER_TIME', itime, &
+         turnover_time, npts*nvm, horipft_index)
+    ! land cover change
+    CALL histwrite (hist_id_stomate, 'PROD10', itime, &
+         prod10, npts*11, horip11_index)
+    CALL histwrite (hist_id_stomate, 'PROD100', itime, &
+         prod100, npts*101, horip101_index)
+    CALL histwrite (hist_id_stomate, 'FLUX10', itime, &
+         flux10, npts*10, horip10_index)
+    CALL histwrite (hist_id_stomate, 'FLUX100', itime, &
+         flux100, npts*100, horip100_index)
+
+    IF ( hist_id_stomate_IPCC > 0 ) THEN
+       vartmp(:)=SUM(tot_live_biomass*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cVeg", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(tot_litter_carb*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cLitter", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(tot_soil_carb*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cSoil", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=(prod10_total + prod100_total)/1e3
+       CALL histwrite (hist_id_stomate_IPCC, "cProduct", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=carb_mass_variation/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cMassVariation", itime, &
+            vartmp, npts, hori_index)
+
+       vartmp(:)=SUM(lai*veget_max,dim=2)*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "lai", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(gpp_daily*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (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 (hist_id_stomate_IPCC, "ra", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(npp_daily*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "npp", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_hetero*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "rh", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(co2_fire*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "fFire", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=harvest_above/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "fHarvest", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=cflux_prod_total/1e3/one_day*contfrac
+       CALL histwrite (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 (hist_id_stomate_IPCC, "nbp", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(tot_bm_to_litter*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "fVegLitter", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(SUM(soilcarbon_input,dim=2)*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "fLitterSoil", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(biomass(:,:,ileaf)*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cLeaf", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((biomass(:,:,isapabove)+biomass(:,:,iheartabove))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cWood", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( biomass(:,:,iroot) + biomass(:,:,isapbelow) + biomass(:,:,iheartbelow) ) &
+            &        *veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cRoot", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( biomass(:,:,icarbres) + biomass(:,:,ifruit))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cMisc", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((litter(:,istructural,:,iabove)+litter(:,imetabolic,:,iabove))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cLitterAbove", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM((litter(:,istructural,:,ibelow)+litter(:,imetabolic,:,ibelow))*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cLitterBelow", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(carbon(:,iactive,:)*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cSoilFast", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(carbon(:,islow,:)*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cSoilMedium", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(carbon(:,ipassive,:)*veget_max,dim=2)/1e3*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "cSoilSlow", itime, &
+            vartmp, npts, hori_index)
+       DO j=1,nvm
+          histvar(:,j)=veget_max(:,j)*contfrac(:)*100
+       ENDDO
+       CALL histwrite (hist_id_stomate_IPCC, "landCoverFrac", itime, &
+            histvar, npts*nvm, horipft_index)
+       vartmp(:)=(veget_max(:,3)+veget_max(:,6)+veget_max(:,8)+veget_max(:,9))*contfrac*100
+       CALL histwrite (hist_id_stomate_IPCC, "treeFracPrimDec", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=(veget_max(:,2)+veget_max(:,4)+veget_max(:,5)+veget_max(:,7))*contfrac*100
+       CALL histwrite (hist_id_stomate_IPCC, "treeFracPrimEver", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=(veget_max(:,10)+veget_max(:,12))*contfrac*100
+       CALL histwrite (hist_id_stomate_IPCC, "c3PftFrac", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=(veget_max(:,11)+veget_max(:,13))*contfrac*100
+       CALL histwrite (hist_id_stomate_IPCC, "c4PftFrac", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_growth*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "rGrowth", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(resp_maint*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "rMaint", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(bm_alloc(:,:,ileaf)*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "nppLeaf", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(bm_alloc(:,:,isapabove)*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "nppWood", itime, &
+            vartmp, npts, hori_index)
+       vartmp(:)=SUM(( bm_alloc(:,:,isapbelow) + bm_alloc(:,:,iroot) )*veget_max,dim=2)/1e3/one_day*contfrac
+       CALL histwrite (hist_id_stomate_IPCC, "nppRoot", itime, &
+            vartmp, npts, hori_index)
+
+       CALL histwrite (hist_id_stomate_IPCC, 'RESOLUTION_X', itime, &
+            resolution(:,1), npts, hori_index)
+       CALL histwrite (hist_id_stomate_IPCC, 'RESOLUTION_Y', itime, &
+            resolution(:,2), npts, hori_index)
+       CALL histwrite (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, veget, &
+       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), INTENT(inout)        :: veget            !! fractional coverage on natural/agricultural 
+                                                                               !! ground, taking into account LAI (=grid-scale 
+                                                                               !! fpc) @tex $(m^2 m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: bm_to_litter     !! conversion of biomass to litter 
+                                                                               !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), 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 (j > 11) THEN
+             above_old = turnover_daily(i,j,ileaf) + turnover_daily(i,j,isapabove) + &
+                  &       turnover_daily(i,j,iheartabove) + turnover_daily(i,j,ifruit) + &
+                  &       turnover_daily(i,j,icarbres) + turnover_daily(i,j,isapbelow) + &
+                  &       turnover_daily(i,j,iheartbelow) + turnover_daily(i,j,iroot)
+
+             turnover_daily(i,j,ileaf) = turnover_daily(i,j,ileaf)*0.55
+             turnover_daily(i,j,isapabove) = turnover_daily(i,j,isapabove)*0.55
+             turnover_daily(i,j,isapbelow) = turnover_daily(i,j,isapbelow)*0.55
+             turnover_daily(i,j,iheartabove) = turnover_daily(i,j,iheartabove)*0.55
+             turnover_daily(i,j,iheartbelow) = turnover_daily(i,j,iheartbelow)*0.55
+             turnover_daily(i,j,iroot) = turnover_daily(i,j,iroot)*0.55
+             turnover_daily(i,j,ifruit) = turnover_daily(i,j,ifruit)*0.55
+             turnover_daily(i,j,icarbres) = turnover_daily(i,j,icarbres)*0.55
+             harvest_above(i)  = harvest_above(i) + veget_max(i,j) * above_old *0.45
+
+          ENDIF
+       ENDDO
+    ENDDO
+
+!$    harvest_above = harvest_above
+  END SUBROUTINE harvest
+END MODULE stomate_lpj
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_npp.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_npp.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_npp.f90	(revision 854)
@@ -0,0 +1,603 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC npp_calc,npp_calc_clear
+
+  LOGICAL, SAVE                                              :: firstcall = .TRUE.         !! first call
+
+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), 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), 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), PARAMETER                                    :: tax_max = 0.8    !! Maximum fraction of allocatable biomass used 
+                                                                                  !! for maintenance respiration (unitless)
+    REAL(r_std), SAVE, DIMENSION(0:nbdl)                      :: z_soil           !! Soil levels  representing soil depth (m)				
+    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 ( 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) = biomass(i,j,ileaf) - &
+                  bm_pump(i) * resp_maint_part(i,j,ileaf) / resp_maint(i,j)
+             biomass(i,j,isapabove) = biomass(i,j,isapabove) - &
+                  bm_pump(i) * resp_maint_part(i,j,isapabove) / resp_maint(i,j)
+             biomass(i,j,isapbelow) = biomass(i,j,isapbelow) - &
+                  bm_pump(i) * resp_maint_part(i,j,isapbelow) / resp_maint(i,j)
+             biomass(i,j,iroot) = biomass(i,j,iroot) - &
+                  bm_pump(i) * resp_maint_part(i,j,iroot) / resp_maint(i,j)
+             biomass(i,j,ifruit) = biomass(i,j,ifruit) - &
+                  bm_pump(i) * resp_maint_part(i,j,ifruit) / resp_maint(i,j)
+             biomass(i,j,icarbres) = biomass(i,j,icarbres) - &
+                  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) = 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,:) / dt
+       bm_alloc(:,j,:) = ( un - frac_growthresp ) * bm_alloc(:,j,:)
+
+       
+       !! 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)
+    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) .LT. zero )
+
+             bm_create(:,j) = min_stomate - biomass(:,j,k)
+             
+             biomass(:,j,k) = biomass(:,j,k) + 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)
+    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) .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) ) / &
+               & 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) .GT. min_stomate )
+
+          leaf_frac(:,j,1) = leaf_mass_young(:,j) / biomass(:,j,ileaf)
+
+       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) .GT. min_stomate )
+
+             leaf_frac(:,j,m) = leaf_frac(:,j,m) * lm_old(:,j) / biomass(:,j,ileaf)
+
+          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. tree(j) ) THEN
+
+          bm_new(:) = biomass(:,j,ileaf) + biomass(:,j,isapabove) + &
+               biomass(:,j,iroot) + biomass(:,j,ifruit)
+          bm_add(:) = bm_alloc(:,j,ileaf) + bm_alloc(:,j,isapabove) + &
+               bm_alloc(:,j,iroot) + bm_alloc(:,j,ifruit)
+
+          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 (hist_id_stomate, 'BM_ALLOC_LEAF', itime, &
+         bm_alloc(:,:,ileaf), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'BM_ALLOC_SAP_AB', itime, &
+         bm_alloc(:,:,isapabove), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'BM_ALLOC_SAP_BE', itime, &
+         bm_alloc(:,:,isapbelow), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'BM_ALLOC_ROOT', itime, &
+         bm_alloc(:,:,iroot), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'BM_ALLOC_FRUIT', itime, &
+         bm_alloc(:,:,ifruit), npts*nvm, horipft_index)
+    CALL histwrite (hist_id_stomate, 'BM_ALLOC_RES', itime, &
+         bm_alloc(:,:,icarbres), npts*nvm, horipft_index)
+
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving npp'
+
+  END SUBROUTINE npp_calc
+
+END MODULE stomate_npp
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_phenology.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_phenology.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_phenology.f90	(revision 854)
@@ -0,0 +1,1711 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC phenology,phenology_clear
+
+  ! first call
+  LOGICAL, SAVE                                              :: firstcall = .TRUE.
+  LOGICAL, SAVE                                              :: firstcall_hum = .TRUE.
+  LOGICAL, SAVE                                              :: firstcall_moi = .TRUE.
+  LOGICAL, SAVE                                              :: firstcall_humgdd = .TRUE.
+  LOGICAL, SAVE                                              :: firstcall_moigdd = .TRUE.
+
+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 ::pheno_crit%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
+!!                ::pheno_crit%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_crit%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
+!!                ::pheno_crit%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_lowgpp, time_hum_min, &
+       biomass, leaf_frac, leaf_age, &
+       when_growthinit, co2_to_bm, lai)
+
+    !
+    !! 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_lowgpp          !! duration of dormance (days)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                        :: time_hum_min         !! time elapsed since strongest 
+                                                                                                !! moisture availability (days) 
+
+    !
+    !! 0.2 Ouput variables 
+    ! CHECK - DON'T THINK THIS IS OUTPUT?
+    !
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)                     :: lai                  !! leaf area index @tex ($m^2 
+                                                                                                !! m^{-2}$) @endtex
+
+    !
+    !! 0.3 Modified variables
+    !
+    REAL(r_std), DIMENSION(npts,nvm,nparts), 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, PARAMETER                                                  :: always_init = .FALSE. !! take carbon from atmosphere if 
+                                                                                                 !! carbohydrate reserve too 
+                                                                                                 !! small? (true/false) 
+    REAL(r_std), PARAMETER                                              :: min_growthinit_time = 300. !! minimum time since last 
+                                                                                                    !! beginning of a growing 
+                                                                                                    !! season (days) 
+    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, ::pheno_crit%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 ( ( time_lowgpp(:,j) .GE. pheno_crit%lowgpp_time(j) ) .AND. &
+            ( 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 (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_crit%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.
+
+    DO j = 2,nvm ! Loop over # PFTs
+
+       SELECT CASE ( pheno_crit%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_crit%pheno_model(j)) : ',pheno_crit%pheno_model(j)
+          STOP
+
+       END SELECT
+
+    ENDDO
+
+    WHERE(begin_leaves)
+       histvar=un
+    ELSEWHERE
+       histvar=zero
+    ENDWHERE
+    CALL histwrite (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) = pheno_crit%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) .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) .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) ) / dt
+
+                   biomass(i,j,icarbres) = 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), bm_wanted(i) )
+
+                !
+                !! 4.2.4 divide the biomass which is available to use equally between the leaves and roots.
+                !
+
+                biomass(i,j,ileaf) = biomass(i,j,ileaf) + bm_use(i) / 2.
+
+                biomass(i,j,iroot) = biomass(i,j,iroot) + 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) = biomass(i,j,icarbres) - 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) = 0.0
+
+          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
+!!                ::pheno_crit%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
+!!                ::pheno_crit%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), PARAMETER                                                 :: moiavail_always_tree = un !! moisture monthly 
+                                                                                                    !! availability above which 
+                                                                                                    !! moisture tendency doesn't 
+                                                                                                    !! matter - for trees 
+                                                                                                    !! (0-1, unitless)
+    REAL(r_std), PARAMETER                                                 :: moiavail_always_grass = 0.6 !! moisture monthly 
+                                                                                                    !! availability above which 
+                                                                                                    !! moisture tendency doesn't 
+                                                                                                    !! matter - for grass 
+                                                                                                    !! (0-1, unitless)
+    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 ::pheno_crit%hum_frac is defined. If not, stop.
+    !
+
+    IF ( pheno_crit%hum_frac(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'hum: pheno_crit%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 ( 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 ::pheno_crit%hum_frac.
+
+          availability_crit(i) = minmoiavail_lastyear(i,j) + pheno_crit%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 ::pheno_crit%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
+!!                ::pheno_crit%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), PARAMETER                                   :: moiavail_always_tree = un       !! moisture availability above 
+                                                                                                !! which moisture tendency doesn't 
+                                                                                                !! matter - for trees 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), PARAMETER                                   :: moiavail_always_grass = 0.6     !! moisture availability above 
+                                                                                                !! which moisture tendency doesn't 
+                                                                                                !! matter - for grass 
+                                                                                                !! (0-1, unitless)
+    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 ::pheno_crit%hum_min_time is definded. If not, stop
+    !
+
+    IF ( pheno_crit%hum_min_time(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'moi: pheno_crit%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 ( 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 ::pheno_crit%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. pheno_crit%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 (::pheno_crit%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), PARAMETER                                   :: moiavail_always_tree = un       !! moisture availability above 
+                                                                                                !! which moisture tendency doesn't 
+                                                                                                !! matter - for trees 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), PARAMETER                                   :: moiavail_always_grass = 0.6     !! moisture availability above 
+                                                                                                !! which moisture tendency doesn't 
+                                                                                                !! matter - for grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), PARAMETER                                   :: t_always = ZeroCelsius + 10.    !! monthly temp., above which temp. 
+                                                                                                !! tendency doesn't matter (K) 
+    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 ::pheno_crit%gdd and ::pheno_crit_hum_frac are defined.
+    !!     If not, stop.
+    !
+
+    IF ( ANY(pheno_crit%gdd(j,:) .EQ. undef) ) THEN
+
+       WRITE(numout,*) 'humgdd: pheno_crit%gdd is undefined for PFT (::j) ',j
+       WRITE(numout,*) 'We stop.'
+       STOP
+
+    ENDIF
+
+    IF ( pheno_crit%hum_frac(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'humgdd: pheno_crit%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 ( 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 ::pheno_crit%hum_frac.,
+          !! (as in the ::pheno_hum model), as per the equation:
+
+
+          moiavail_crit(i) = minmoiavail_lastyear(i,j) + pheno_crit%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_crit%gdd(j,1) + tl(i)*pheno_crit%gdd(j,2) + &
+               tl(i)*tl(i)*pheno_crit%gdd(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 (::pheno_crit%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), PARAMETER                                   :: moiavail_always_tree = un       !! moisture availability above 
+                                                                                                !! which moisture tendency doesn't 
+                                                                                                !! matter - for trees 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), PARAMETER                                   :: moiavail_always_grass = 0.6     !! moisture availability above 
+                                                                                                !! which moisture tendency doesn't 
+                                                                                                !! matter - for grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std)                                              :: moiavail_always                 !! critical moisture availability - 
+                                                                                                !! set for tree or grass 
+                                                                                                !! (0-1, unitless)
+    REAL(r_std), PARAMETER                                   :: t_always = ZeroCelsius + 10.    !! monthly temp. above which temp. 
+                                                                                                !! tendency doesn't matter (C) 
+    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 ::pheno_crit%gdd and ::pheno_crit_hum_min_time are defined.
+    !!     If not, stop.
+    !
+
+    IF ( ANY(pheno_crit%gdd(j,:) .EQ. undef) ) THEN
+
+       WRITE(numout,*) 'moigdd: pheno_crit%gdd is undefined for PFT',j
+       WRITE(numout,*) 'We stop.'
+       STOP
+
+    ENDIF
+
+    IF ( pheno_crit%hum_min_time(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'moigdd: pheno_crit%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 ( 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_crit%gdd(j,1) + tl(i)*pheno_crit%gdd(j,2) + &
+               tl(i)*tl(i)*pheno_crit%gdd(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. pheno_crit%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
+!!                (::pheno_crit%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 
+!!                ::pheno_crit%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 ::pheno_crit%ncdgdd_temp is defined.
+    !!     If not, stop.
+    !
+
+    IF ( pheno_crit%ncdgdd_temp(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'ncdgdd: pheno_crit%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 = ( 603. / exp(0.0091*ncd_dormance(i,j)) - 64. )
+
+          !! 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, 
+!!                ::pheno_crit%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
+!!                ::pheno_crit%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 ::pheno_crit%ngd is defined.
+    !!     If not, stop.
+    !
+
+    IF ( pheno_crit%ngd(j) .EQ. undef ) THEN
+
+       WRITE(numout,*) 'ngd: pheno_crit%ngd 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. pheno_crit%ngd(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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_prescribe.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_prescribe.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_prescribe.f90	(revision 854)
@@ -0,0 +1,338 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC prescribe,prescribe_clear
+
+    ! first call
+    LOGICAL, SAVE                                              :: firstcall = .TRUE.
+
+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, PFTpresent, everywhere, when_growthinit, &
+                        biomass, leaf_frac, ind, cn_ind)
+
+!! INTERFACE DESCRIPTION
+
+!! INPUT SCALAR
+    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)
+
+!! MODIFIED FIELD
+    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), 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)
+
+!! OUTPUT FIELDS 
+
+!! 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)
+
+!? this one is not used and should be deleted
+!! PARAMETER VALUES
+    REAL(r_std), PARAMETER                                    :: cn_tree = 4.    !! generic tree crown area (m^2)
+
+    ! =========================================================================
+
+    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) = 0.0
+
+        IF ( tree(j) ) THEN
+
+          !
+          !! 1.1 treat for trees
+          !
+
+          dia(:) = 0.0
+
+          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) + biomass(i,j,isapbelow) + &
+                   biomass(i,j,iheartabove) + biomass(i,j,iheartbelow)) * 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) ) ** 1.6
+
+                !! 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))**(1.6/(2.+pipe_tune3)) ) ) &
+                             ** (1./(1.-(1.6/(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) ) ** 1.6
+
+                ENDIF
+
+              ELSE !woodmas=0  => impose some value
+
+                dia(:) = maxdia(j)
+
+                cn_ind(i,j) = pipe_tune1 * MIN( maxdia(j), dia(i) ) ** 1.6
+
+              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. 0.0 )
+            cn_ind(:,j) = un
+          ENDWHERE
+
+        ENDIF   !IF ( tree(j) )
+
+        !
+        !! 2 density of individuals
+        !
+        
+        WHERE ( veget_max(:,j) .GT. 0.0 )
+
+          ind(:,j) = veget_max(:,j) / cn_ind(:,j)  
+
+        ELSEWHERE
+
+          ind(:,j) = 0.0
+
+        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 ) 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 ( tree(j) .AND. &
+                 ( veget_max(i,j) .GT. min_stomate ) .AND. &
+                 ( SUM( biomass(i,j,:) ) .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,:) = (40. * 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_crit%pheno_model(j) .NE. 'none' ) THEN
+
+                biomass(i,j,ileaf) = zero
+                leaf_frac(i,j,1) = zero
+
+              ENDIF
+
+            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. tree(j) ) .AND. &
+                 ( veget_max(i,j) .GT. min_stomate ) .AND. &
+                 ( SUM( biomass(i,j,:) ) .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
+
+            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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_resp.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_resp.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_resp.f90	(revision 854)
@@ -0,0 +1,360 @@
+! =================================================================================================================================
+! 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_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC maint_respiration,maint_respiration_clear
+
+  LOGICAL, SAVE                                              :: firstcall = .TRUE.                 !! first call
+
+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),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)
+    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) = 0.0
+
+       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 ( 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) ), 0._r_std )
+
+       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) * 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) > 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) * &
+!$                                 ( .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) * &
+!$                                 ( .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) * &
+                        ( .3*lai(i,j) + 1.4*(1.-exp(-.5*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)
+
+          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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_season.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_season.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_season.f90	(revision 854)
@@ -0,0 +1,1445 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC season,season_clear
+
+  LOGICAL, SAVE                                          :: firstcall = .TRUE.  !! first call (true/false)
+
+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, &
+       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_lowgpp, &
+       time_hum_min, hum_min_dormance, 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), 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), INTENT(in)    :: biomass           !! biomass @tex ($gC m^{-2} of ground$) @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nparts), 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), 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_lowgpp               !! duration of dormance (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)
+
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                                          :: j                        !! indices (unitless)
+    REAL(r_std), PARAMETER                                  :: gppfrac_dormance = 0.2   !! report maximal GPP/GGP_max for dormance 
+                                                                                        !! (unitless) 
+    !NVADD
+    REAL(r_std), PARAMETER                                  :: min_gpp_allowed = 0.3    !! minimum gpp considered as not "lowgpp"  
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), PARAMETER                                  :: tau_climatology = 20     !! tau for "climatologic" variables (year) 
+    !ENDNVADD
+    REAL(r_std)                                             :: ncd_max                  !! maximum ncd (to avoid floating point 
+                                                                                        !! underflows) (days) 
+    REAL(r_std), PARAMETER                                  :: hvc1 = 0.019             !! parameters for herbivore activity 
+                                                                                        !! (unitless) 
+    REAL(r_std), PARAMETER                                  :: hvc2 = 1.38              !! parameters for herbivore activity 
+                                                                                        !! (unitless) 
+    REAL(r_std), PARAMETER                                  :: leaf_frac=.33            !! leaf fraction (0-1, unitless)
+    REAL(r_std), DIMENSION(npts)                            :: sumfpc_nat               !! sum of natural fpcs (0-1, unitless)
+                                                                                        !! [DISPENSABLE] 
+    REAL(r_std), DIMENSION(npts)                            :: weighttot                !! weight of biomass @tex ($gC m^{-2}$) 
+                                                                                        !! @endtex 
+    REAL(r_std), DIMENSION(npts)                            :: nlflong_nat              !! natural long-term leaf NPP 
+                                                                                        !! @tex ($gC m^{-2} year^{-1}$) @endtex
+    REAL(r_std), DIMENSION(npts)                            :: 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)
+
+    !! =========================================================================
+
+    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 = 3. * 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)*100 ',leaf_frac*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
+
+       !
+       !! 1.4 reset firstcall flag
+       !
+
+       firstcall = .FALSE.
+
+    ENDIF
+
+    !
+    !! 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 ::pheno_crit%tau_hum_month (for the monthly
+    !!    calculation) or ::pheno_crit%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 * ( pheno_crit%tau_hum_month - dt ) + &
+         moiavail_daily * dt ) / pheno_crit%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 * ( pheno_crit%tau_hum_week - dt ) + &
+         moiavail_daily * dt ) / pheno_crit%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 ::pheno_crit%tau_longterm, 
+    !!    ::pheno_crit%tau_t2m_month, and ::pheno_crit%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 * ( pheno_crit%tau_longterm - dt ) + &
+         t2m_daily * dt ) / pheno_crit%tau_longterm
+
+    WHERE ( ABS(t2m_longterm(:)) .LT. EPSILON(zero) ) 
+       t2m_longterm(:) = zero
+    ENDWHERE
+
+    CALL histwrite (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 * ( pheno_crit%tau_t2m_month - dt ) + &
+         t2m_daily * dt ) / pheno_crit%tau_t2m_month
+
+    WHERE ( ABS(t2m_month(:)) .LT. EPSILON(zero) )
+       t2m_month(:) = zero
+    ENDWHERE
+
+    !
+    !! 3.4 "weekly" (::t2m_week)
+    !
+
+    t2m_week = ( t2m_week * ( pheno_crit%tau_t2m_week - dt ) + &
+         t2m_daily * dt ) / pheno_crit%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 ::pheno_crit%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 * ( pheno_crit%tau_tsoil_month - dt ) + &
+         tsoil_daily(:,:) * dt ) / pheno_crit%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 ::pheno_crit%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 * ( pheno_crit%tau_soilhum_month - dt ) + &
+         soilhum_daily * dt ) / pheno_crit%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) .GT. biomass(:,j,ileaf)*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) .GT. biomass(:,j,ileaf)*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
+
+       ! 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_crit%gdd(j,:) .NE. undef) ) THEN
+
+          !
+          !! 7.1 set to zero if undefined and there is no GPP
+          !
+
+          WHERE ( ( time_lowgpp(:,j) .GT. zero ) .AND. ( gdd_m5_dormance(:,j) .EQ. undef ) )
+
+             gdd_m5_dormance(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 7.2 set to undef if there is GPP
+          !
+
+          WHERE ( time_lowgpp(:,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-5.) ) .AND. &
+               ( gdd_m5_dormance(:,j) .NE. undef )           )
+             gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) + &
+                  dt * ( t2m_daily(:) - (ZeroCelsius-5.) )
+          ENDWHERE
+
+          WHERE ( gdd_m5_dormance(:,j) .NE. undef ) 
+             gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) * &
+                  ( pheno_crit%tau_gdd - dt ) / pheno_crit%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 (::pheno_crit%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 ::pheno_crit%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 ( pheno_crit%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(:) )    )
+
+             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. pheno_crit%ncdgdd_temp(j)+ZeroCelsius ) )
+
+             gdd_midwinter(:,j) = &
+                  gdd_midwinter(:,j) + &
+                  dt * ( t2m_daily(:) - ( pheno_crit%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 ::pheno_crit%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 ( pheno_crit%ncdgdd_temp(j) .NE. undef ) THEN
+
+          !
+          !! 9.1 set to zero if undefined and there is no GPP
+          !
+
+          WHERE ( ( time_lowgpp(:,j) .GT. zero ) .AND. ( ncd_dormance(:,j) .EQ. undef ) )
+
+             ncd_dormance(:,j) = zero
+
+          ENDWHERE
+
+          !
+          !! 9.2 set to undef if there is GPP
+          !
+
+          WHERE ( time_lowgpp(:,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. pheno_crit%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 ( time_lowgpp(:,j) .LT. min_stomate )
+          ngd_minus5(:,j) = zero
+       ENDWHERE
+
+       !
+       !! 10.2 normal update, as described above.
+       !
+
+       WHERE ( t2m_daily(:) .GT. (ZeroCelsius-5.) )
+          ngd_minus5(:,j) = ngd_minus5(:,j) + dt
+       ENDWHERE
+
+       ngd_minus5(:,j) = ngd_minus5(:,j) * ( pheno_crit%tau_ngd - dt ) / pheno_crit%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 ::pheno_crit%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 ( pheno_crit%hum_min_time(j) .NE. undef ) THEN
+
+          !
+          !! 11.1 initialize if undefined and there is no GPP
+          !
+
+          WHERE ( ( time_lowgpp(:,j) .GT. zero ) .AND. &
+               ( ( time_hum_min(:,j) .EQ. undef ) .OR. ( hum_min_dormance(:,j) .EQ. undef ) ) )
+
+             time_hum_min(:,j) = zero
+             hum_min_dormance(:,j) = moiavail_month(:,j)
+
+          ENDWHERE
+
+          !
+          !! 11.2 set to undef where there is GPP
+          !
+
+          WHERE ( time_lowgpp(:,j) .EQ. zero )
+
+             time_hum_min(:,j) = undef
+             hum_min_dormance(:,j) = undef
+
+          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 ( ( time_hum_min(:,j) .NE. undef ) .AND. &
+               ( 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 ( ( time_hum_min(:,j) .NE. undef ) .AND. &
+               ( 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 ::pheno_crit%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 * ( pheno_crit%tau_longterm - dt ) + &
+         (npp_daily*one_year) * dt                          ) / &
+         pheno_crit%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 ::pheno_crit%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 * ( pheno_crit%tau_longterm - dt ) + &
+         (turnover_daily*one_year) * dt                          ) / &
+         pheno_crit%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 ::pheno_crit%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 * ( pheno_crit%tau_gpp_week - dt ) + &
+            gpp_daily * dt ) / pheno_crit%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).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).GT. lm_lastyearmax(:,j)*0.75)
+!!$                lm_lastyearmax(:,j) = ( lm_lastyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+!!$                     biomass(:,j,ileaf) * 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).GT. lm_thisyearmax(:,j)*0.75)
+                   lm_thisyearmax(:,j) = ( lm_thisyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
+                        biomass(:,j,ileaf) * dt ) / (one_year/leaflife_tab(j))
+                ENDWHERE
+             ELSEWHERE
+                lm_thisyearmax(:,j) =biomass(:,j,ileaf)
+             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) .GT. lm_thisyearmax(:,j) )
+                lm_thisyearmax(:,j) = biomass(:,j,ileaf)
+             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(:) = weighttot(:) + 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(:) = nlflong_nat(:) + npp_longterm(:,j) * leaf_frac
+          
+          !
+          !! 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_crit%pheno_model, which specifies the onset model of the PFT.
+ 
+          !
+          IF ( pheno_crit%pheno_model(j) .EQ. 'none' ) THEN
+             green_age(:) = green_age(:) + 2. * lm_lastyearmax(:,j)
+          ELSE
+             green_age(:) = green_age(:) + .5 * 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(:) .GT. zero )
+             consumption(:) = hvc1 * nlflong_nat(:) ** hvc2
+             herbivores(:,j) = one_year * green_age(:) * nlflong_nat(:) / 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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_soilcarbon.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_soilcarbon.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_soilcarbon.f90	(revision 854)
@@ -0,0 +1,306 @@
+! =================================================================================================================================
+! 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: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN		:
+!! $HeadURL$ 
+!! $Date$
+!! $Revision$
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_soilcarbon
+
+  ! modules used:
+
+  USE ioipsl
+  USE stomate_constants
+
+  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)
+
+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.
+!!
+!! FLOWCHART    :
+!! \latexonly
+!! \includegraphics[scale=0.5]{soilcarbon_flowchart.jpg}
+!! \endlatexonly
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE soilcarbon (npts, dt, clay, &
+       soilcarbon_input, control_temp, control_moist, &
+       carbon, &
+       resp_hetero_soil)
+
+
+!! 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,ncarb,nvm), INTENT(in)    :: 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,nlevs), INTENT(in)        :: control_temp     !! Temperature control of heterotrophic respiration (unitless: 0->1)
+    REAL(r_std), DIMENSION(npts,nlevs), INTENT(in)        :: control_moist    !! Moisture control of heterotrophic respiration (unitless: 0.25->1)
+
+    !! 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
+
+    !! 0.3 Modified variables
+    
+    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon           !! Soil carbon pools: active, slow, or passive, \f$(gC m^{2})$\f
+
+    !! 0.4 Local variables
+    REAL(r_std), SAVE, DIMENSION(ncarb)                   :: carbon_tau       !! Residence time in carbon pools (days)
+    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)                    :: frac_resp        !! Flux fractions from carbon pools to the atmosphere (respiration) (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,ncarb)                    :: fluxtot          !! Total flux out of carbon pools \f$(gC m^{2})$\f
+    REAL(r_std), DIMENSION(npts,ncarb,ncarb)              :: 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)
+    INTEGER(i_std)                                        :: k,kk,m           !! Indices (unitless)
+
+!_=============================================================================
+
+    !! bavard is the level of diagnostic information, 0 (none) to 4 (full)
+    IF (bavard.GE.3) WRITE(numout,*) 'Entering soilcarbon' 
+
+!! 1. Initializations
+    
+    !! 1.1 Get soil "constants"
+    !! 1.1.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,ipassive) = 0.004
+    frac_carb(:,iactive,islow) = un - (.85 - .68*clay(:)) - frac_carb(:,iactive,ipassive)
+
+    ! From slow pool
+    frac_carb(:,islow,islow) = .0
+    frac_carb(:,islow,iactive) = .42
+    frac_carb(:,islow,ipassive) = .03
+
+    ! From passive pool
+    frac_carb(:,ipassive,ipassive) = .0
+    frac_carb(:,ipassive,iactive) = .45
+    frac_carb(:,ipassive,islow) = .0
+
+    IF ( firstcall ) THEN
+
+        !! 1.1.2 Residence times in carbon pools (days)
+        carbon_tau(iactive) = 0.149 * one_year       ! 1.5 years. This is same as CENTURY. But, in Parton et al. (1987), it's weighted by moisture and temperature dependences.
+        carbon_tau(islow) = 5.48 * one_year          ! 25 years. This is same as CENTURY. But, in Parton et al. (1987), it's weighted by moisture and temperature dependences.
+        carbon_tau(ipassive) = 241. * one_year       ! 1000 years. This is same as CENTURY. But, in Parton et al. (1987), it's weighted by moisture and temperature dependences.
+        
+        !! 1.2 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.3 Set soil respiration to zero
+    resp_hetero_soil(:,:) = zero
+
+!! 2. Update the carbon stocks with the different soil carbon input
+
+    carbon(:,:,:) = carbon(:,:,:) + soilcarbon_input(:,:,:) * dt
+
+!! 3. Fluxes between carbon reservoirs, and to the atmosphere (respiration) \n
+
+    !! 3.1. Determine the respiration fraction : what's left after
+    ! subtracting all the 'pool-to-pool' flux fractions
+    ! Diagonal elements of frac_carb are zero
+    !    VPP killer:
+    !     frac_resp(:,:) = 1. - SUM( frac_carb(:,:,:), DIM=3 )
+    frac_resp(:,:) = un - frac_carb(:,:,iactive) - frac_carb(:,:,islow) - &
+         frac_carb(:,:,ipassive) 
+
+    !! 3.2. Calculate fluxes
+
+    DO m = 2,nvm ! Loop over # PFTs
+
+      !! 3.2.1. Flux out of pools
+
+      DO k = 1, ncarb ! Loop over carbon pools from which the flux comes
+        
+        ! Determine total flux out of pool
+        ! S.L. Piao 2006/05/05 - for crop multiply tillage factor of decomposition
+        ! Not crop
+         IF ( natural(m) ) THEN
+            fluxtot(:,k) = dt/carbon_tau(k) * carbon(:,k,m) * &
+                 control_moist(:,ibelow) * control_temp(:,ibelow)
+         ! C3 crop
+         ELSEIF ( PFT_name(m)=='          C3           agriculture' ) THEN
+            fluxtot(:,k) = dt/carbon_tau(k) * carbon(:,k,m) * &
+                 control_moist(:,ibelow) * control_temp(:,ibelow) * 1.2
+         ! C4 Crop
+         ELSEIF ( PFT_name(m)=='          C4           agriculture' ) THEN
+             fluxtot(:,k) = dt/carbon_tau(k) * carbon(:,k,m) * &
+                  control_moist(:,ibelow) * control_temp(:,ibelow) * 1.4
+        ENDIF
+        ! 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) = fluxtot(:,k) * ( un - 0.75 * clay(:) )
+        ENDIF
+        
+        ! Update the loss in each carbon pool
+        carbon(:,k,m) = carbon(:,k,m) - fluxtot(:,k)
+        
+        ! Fluxes towards the other pools (k -> kk)
+        DO kk = 1, ncarb ! Loop over the carbon pools where the flux goes
+          flux(:,k,kk) = frac_carb(:,k,kk) * fluxtot(:,k)
+        ENDDO
+        
+      ENDDO ! End of loop over carbon pools
+      
+      !! 3.2.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.
+      !
+      !       VPP killer:
+      !       resp_hetero_soil(:,m) = SUM( frac_resp(:,:) * fluxtot(:,:), DIM=2 ) / dt
+      
+      resp_hetero_soil(:,m) = &
+         ( frac_resp(:,iactive) * fluxtot(:,iactive) + &
+         frac_resp(:,islow) * fluxtot(:,islow) + &
+         frac_resp(:,ipassive) * fluxtot(:,ipassive)  ) / dt
+      
+      !! 3.2.3 add fluxes to active, slow, and passive pools
+      !       VPP killer:
+      !       carbon(:,:,m) = carbon(:,:,m) + SUM( flux(:,:,:), DIM=2 )
+      
+      DO k = 1, ncarb ! Loop over carbon pools
+        carbon(:,k,m) = carbon(:,k,m) + &
+           flux(:,iactive,k) + flux(:,ipassive,k) + flux(:,islow,k)
+      ENDDO ! Loop over carbon pools
+      
+    ENDDO ! End loop over PFTs
+    
+    IF (bavard.GE.4) WRITE(numout,*) 'Leaving soilcarbon'
+    
+  END SUBROUTINE soilcarbon
+
+END MODULE stomate_soilcarbon
Index: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_turnover.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_turnover.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_turnover.f90	(revision 854)
@@ -0,0 +1,840 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC turn, turn_clear
+
+  LOGICAL, SAVE                          :: firstcall = .TRUE.           !! first call (true/false)
+
+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 ::pheno_crit%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, &
+       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) 
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(npts,nvm,nparts), 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), 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                  !! 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) (::pheno_crit%min_leaf_age_for_senescence) : ',pheno_crit%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(:,:) = 0.0
+
+    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 ( pheno_crit%senescence_type(j) )
+
+       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 ::pheno_crit%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 + pheno_crit%senescence_temp(j,1) + &
+               tl(:) * pheno_crit%senescence_temp(j,2) + &
+               tl(:)*tl(:) * pheno_crit%senescence_temp(j,3)
+
+          WHERE ( ( biomass(:,j,ileaf) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. pheno_crit%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 ::pheno_crit%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) + pheno_crit%hum_frac(j) * &
+               ( maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), &
+               pheno_crit%senescence_hum(j) ), &
+               pheno_crit%nosenescence_hum(j) )
+
+          WHERE ( ( biomass(:,j,ileaf) .GT. zero ) .AND. &
+               ( leaf_meanage(:,j) .GT. pheno_crit%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 ::pheno_crit%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) + pheno_crit%hum_frac(j) * &
+               (maxmoiavail_lastyear(:,j) - minmoiavail_lastyear(:,j) ), &
+               pheno_crit%senescence_hum(j) ), &
+               pheno_crit%nosenescence_hum(j) )
+
+          tl(:) = tlong_ref(:) - ZeroCelsius
+          t_crit(:) = ZeroCelsius + pheno_crit%senescence_temp(j,1) + &
+               tl(:) * pheno_crit%senescence_temp(j,2) + &
+               tl(:)*tl(:) * pheno_crit%senescence_temp(j,3)
+
+          IF ( tree(j) ) THEN
+             ! critical temperature for senescence may depend on long term annual mean temperature
+             WHERE ( ( biomass(:,j,ileaf) .GT. zero ) .AND. &
+                  ( leaf_meanage(:,j) .GT. pheno_crit%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
+             new_turnover_time(:,j)=pheno_crit%max_turnover_time(j)+20
+             WHERE ((moiavail_week(:,j) .LT. moiavail_month(:,j))&
+                  .AND. (moiavail_week(:,j) .LT. pheno_crit%nosenescence_hum(j)))
+                new_turnover_time(:,j)=pheno_crit%max_turnover_time(j) * &
+                     (1.-pheno_crit%nosenescence_hum(j)+moiavail_week(:,j)) * &
+                     (1.-pheno_crit%nosenescence_hum(j)+moiavail_week(:,j)) + &
+                     pheno_crit%min_turnover_time(j)
+             ENDWHERE
+
+             WHERE (new_turnover_time(:,j) .GT. turnover_time(:,j)*1.1)
+                new_turnover_time(:,j)=pheno_crit%max_turnover_time(j)+20
+             ENDWHERE
+
+             turnover_time(:,j)=(turnover_time(:,j)*10./dt+new_turnover_time(:,j))/(10./dt+1.)
+
+          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 (::pheno_crit%senescence_type(j)) : ',pheno_crit%senescence_type(j)
+          STOP
+
+       END SELECT
+
+       !! 3.2 Drop leaves and roots, plus stems and fruits for grasses
+
+       IF ( 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 ::pheno_crit%leaffall(j) a PFT-dependent time constant which is given in ::stomate_constants),
+          WHERE ( senescence(:,j) )
+
+             turnover(:,j,ileaf) = biomass(:,j,ileaf) * dt / pheno_crit%leaffall(j)
+             turnover(:,j,iroot) = biomass(:,j,iroot) * dt / pheno_crit%leaffall(j)
+
+             biomass(:,j,ileaf) = biomass(:,j,ileaf) - turnover(:,j,ileaf)
+             biomass(:,j,iroot) = biomass(:,j,iroot) - turnover(:,j,iroot)
+
+          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.      
+          WHERE (turnover_time(:,j) .LT. pheno_crit%max_turnover_time(j)) 
+             turnover(:,j,ileaf) = biomass(:,j,ileaf) * dt / turnover_time(:,j)
+             turnover(:,j,isapabove) = biomass(:,j,isapabove) * dt / turnover_time(:,j)
+             turnover(:,j,iroot) = biomass(:,j,iroot) * dt / turnover_time(:,j) 
+             turnover(:,j,ifruit) = biomass(:,j,ifruit) * dt / turnover_time(:,j)
+          ELSEWHERE
+             turnover(:,j,ileaf)=zero
+             turnover(:,j,isapabove) =zero
+             turnover(:,j,iroot) = zero
+             turnover(:,j,ifruit) =zero
+          ENDWHERE
+          biomass(:,j,ileaf) = biomass(:,j,ileaf) - turnover(:,j,ileaf)
+          biomass(:,j,isapabove) = biomass(:,j,isapabove) - turnover(:,j,isapabove)
+          biomass(:,j,iroot) = biomass(:,j,iroot) - turnover(:,j,iroot)
+          biomass(:,j,ifruit) = biomass(:,j,ifruit) - turnover(:,j,ifruit)
+
+       ENDIF      ! tree/grass
+
+    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)
+
+       !! initialize leaf mass change in age class
+       delta_lm(:,:) = 0.0
+
+       IF ( tree(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) = pheno_crit%leafagecrit(j)
+
+          !! 4.1.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) )**4._r_std ) )
+
+                dturnover(:) = biomass(:,j,ileaf) * leaf_frac(:,j,m) * turnover_rate(:)
+                turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:)
+                biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:)
+
+                ! save leaf mass change
+                delta_lm(:,m) = - dturnover(:)
+
+                dturnover(:) = biomass(:,j,iroot) * leaf_frac(:,j,m) * turnover_rate(:)
+                turnover(:,j,iroot) = turnover(:,j,iroot) + dturnover(:)
+                biomass(:,j,iroot) = biomass(:,j,iroot) - dturnover(:)
+
+                dturnover(:) = biomass(:,j,ifruit) * leaf_frac(:,j,m) * turnover_rate(:)
+                turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:)
+                biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:)
+
+             ENDWHERE
+
+          ENDDO
+
+       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( pheno_crit%leafagecrit(j) * 1.5_r_std , &
+               MAX( pheno_crit%leafagecrit(j) * 0.75_r_std, &
+               pheno_crit%leafagecrit(j) - 10._r_std * &
+               ( tlong_ref(:)-ZeroCelsius-20._r_std ) ) )
+
+          ! 4.2.2 Loop over leaf age classes
+          DO m = 1, nleafages
+
+             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) )**4._r_std ) )
+
+                dturnover(:) = biomass(:,j,ileaf) * leaf_frac(:,j,m) * turnover_rate(:)
+                turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:)
+                biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:)
+
+                ! save leaf mass change
+                delta_lm(:,m) = - dturnover(:)
+
+                dturnover(:) = biomass(:,j,isapabove) * leaf_frac(:,j,m) * turnover_rate(:)
+                turnover(:,j,isapabove) = turnover(:,j,isapabove) + dturnover(:)
+                biomass(:,j,isapabove) = biomass(:,j,isapabove) - dturnover(:)
+
+                dturnover(:) = biomass(:,j,iroot) * leaf_frac(:,j,m) * turnover_rate(:)
+                turnover(:,j,iroot) = turnover(:,j,iroot) + dturnover(:)
+                biomass(:,j,iroot) = biomass(:,j,iroot) - dturnover(:)
+
+                dturnover(:) = biomass(:,j,ifruit) * leaf_frac(:,j,m) * turnover_rate(:)
+                turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:)
+                biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:)
+
+             ENDWHERE
+          ENDDO
+       ENDIF       ! tree/grass ?
+
+       !! 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) .GT. 0.0 )
+             leaf_frac(:,j,m) = ( leaf_frac(:,j,m)*lm_old(:) + delta_lm(:,m) ) / biomass(:,j,ileaf)
+          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) 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) * 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 ::pheno_crit%lai_initmin(j) divided by the specific leaf area ::sla(j),
+    !     ::pheno_crit%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 ( tree(j) .AND. ( pheno_crit%senescence_type(j) .NE. 'none' ) ) THEN
+
+          ! check whether we shed the remaining leaves
+          WHERE ( ( biomass(:,j,ileaf) .GT. zero ) .AND. senescence(:,j) .AND. &
+               ( biomass(:,j,ileaf) .LT. (pheno_crit%lai_initmin(j) / 2.)/sla(j) )             )
+
+             shed_rest(:) = .TRUE.
+
+             turnover(:,j,ileaf)  = turnover(:,j,ileaf) + biomass(:,j,ileaf)
+             turnover(:,j,iroot)  = turnover(:,j,iroot) + biomass(:,j,iroot)
+             turnover(:,j,ifruit) = turnover(:,j,ifruit) + biomass(:,j,ifruit)
+
+             biomass(:,j,ileaf)  = zero
+             biomass(:,j,iroot)  = zero
+             biomass(:,j,ifruit) = 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), fine root ::biomass(:,j,iroot) and sapwood above 
+       !      ::biomass(:,j,isapabove) carbon pools are set to zero. 
+       IF ( .NOT. tree(j) ) THEN
+
+          ! Shed the remaining leaves if LAI very low.
+          WHERE ( ( biomass(:,j,ileaf) .GT. zero ) .AND. senescence(:,j) .AND. &
+               (  biomass(:,j,ileaf) .LT. (pheno_crit%lai_initmin(j) / 2.)/sla(j) ))
+
+             shed_rest(:) = .TRUE.
+
+             turnover(:,j,ileaf) = turnover(:,j,ileaf) + biomass(:,j,ileaf)
+             turnover(:,j,isapabove) = turnover(:,j,isapabove) + biomass(:,j,isapabove)
+             turnover(:,j,iroot) = turnover(:,j,iroot) + biomass(:,j,iroot)
+             turnover(:,j,ifruit) = turnover(:,j,ifruit) + biomass(:,j,ifruit)
+
+             biomass(:,j,ileaf) = zero
+             biomass(:,j,isapabove) = zero
+             biomass(:,j,iroot) = zero
+             biomass(:,j,ifruit) = 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) and 
+       ! the fruit biomass ::biomass(:,j,ifruit).
+       ! 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 ( tree(j) ) THEN
+
+             !! For trees: only the leaves and fruit carbon pools are affected
+
+             WHERE (biomass(:,j,ileaf) .GT. zero)
+                ! added by shilong
+                WHERE (herbivores(:,j).GT. zero)
+                   dturnover(:) = biomass(:,j,ileaf) * dt / herbivores(:,j)
+                   turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:)
+                   biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:)
+
+                   dturnover(:) = biomass(:,j,ifruit) * dt / herbivores(:,j)
+                   turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:)
+                   biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:)
+                ENDWHERE
+             ENDWHERE
+
+          ELSE
+
+             ! For grasses: all aboveground carbon pools are affected: leaves, fruits and sapwood above
+             WHERE ( biomass(:,j,ileaf) .GT. zero )
+                ! added by shilong
+                WHERE (herbivores(:,j) .GT. zero)
+                   dturnover(:) = biomass(:,j,ileaf) * dt / herbivores(:,j)
+                   turnover(:,j,ileaf) = turnover(:,j,ileaf) + dturnover(:)
+                   biomass(:,j,ileaf) = biomass(:,j,ileaf) - dturnover(:)
+
+                   dturnover(:) = biomass(:,j,isapabove) * dt / herbivores(:,j)
+                   turnover(:,j,isapabove) = turnover(:,j,isapabove) + dturnover(:)
+                   biomass(:,j,isapabove) = biomass(:,j,isapabove) - dturnover(:)
+
+                   dturnover(:) = biomass(:,j,ifruit) * dt / herbivores(:,j)
+                   turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:)
+                   biomass(:,j,ifruit) = biomass(:,j,ifruit) - 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 j = 2,nvm ! Loop over # PFTs
+
+       IF ( tree(j) ) THEN
+
+          dturnover(:) = biomass(:,j,ifruit) * dt / tau_fruit(j)
+          turnover(:,j,ifruit) = turnover(:,j,ifruit) + dturnover(:)
+          biomass(:,j,ifruit) = biomass(:,j,ifruit) - dturnover(:)
+
+
+       ENDIF
+
+    ENDDO       ! loop over PFTs
+
+    !! 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 ( 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) + biomass(:,j,iheartbelow)
+          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).
+
+          ! Above the ground
+          sapconv(:) = biomass(:,j,isapabove) * dt / tau_sap(j)
+          biomass(:,j,isapabove) = biomass(:,j,isapabove) - sapconv(:)
+          biomass(:,j,iheartabove) =  biomass(:,j,iheartabove) + sapconv(:)
+
+          ! Below the ground
+          sapconv(:) = biomass(:,j,isapbelow) * dt / tau_sap(j)
+          biomass(:,j,isapbelow) = biomass(:,j,isapbelow) - sapconv(:)
+          biomass(:,j,iheartbelow) =  biomass(:,j,iheartbelow) + sapconv(:)
+
+          !! 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) + biomass(:,j,iheartbelow)
+
+             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 (hist_id_stomate, 'LEAF_AGE', itime, &
+         leaf_meanage, npts*nvm, horipft_index)
+    CALL histwrite (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: perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_vmax.f90
===================================================================
--- perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_vmax.f90	(revision 854)
+++ perso/abdelouhab.djerrah/ORCHIDEE/src_stomate/stomate_vmax.f90	(revision 854)
@@ -0,0 +1,360 @@
+! =================================================================================================================================
+! 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
+  USE stomate_constants
+  USE constantes_veg
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC vmax, vmax_clear
+
+  ! first call
+  LOGICAL, SAVE                                              :: firstcall = .TRUE.
+
+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)
+
+!! PARAMETER VALUES
+    REAL(r_std), PARAMETER                                     :: vmax_offset = 0.3       !! minimum leaf efficiency (unitless)
+    REAL(r_std), PARAMETER                                     :: leafage_firstmax = 0.03 !! relative leaf age at which efficiency
+                                                                                          !! reaches 1 (unitless)
+    REAL(r_std), PARAMETER                                     :: leafage_lastmax = 0.5   !! relative leaf age at which efficiency 
+                                                                                          !! falls below 1 (unitless)
+    REAL(r_std), PARAMETER                                     :: leafage_old = un        !! relative leaf age at which efficiency
+                                                                                          !! reaches its minimum (vmax_offset) 
+                                                                                          !! (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) / pheno_crit%leafagecrit(j)
+
+          leaf_efficiency(:) = MAX( vmax_offset, MIN( 1._r_std, &
+               vmax_offset + (1._r_std-vmax_offset) * rel_age(:) / leafage_firstmax, &
+               1._r_std - (1._r_std-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
